Initial commit of OpenSPARC T2 architecture model.

[OpenSPARC-T2-SAM] / obp / obp / arch / sun / keystore.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: keystore.fth
\ 
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\ 
\  - Do no alter or remove copyright notices
\ 
\  - Redistribution and use of this software in source and binary forms, with 
\    or without modification, are permitted provided that the following 
\    conditions are met: 
\ 
\  - Redistribution of source code must retain the above copyright notice, 
\    this list of conditions and the following disclaimer.
\ 
\  - Redistribution in binary form must reproduce the above copyright notice,
\    this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution. 
\ 
\    Neither the name of Sun Microsystems, Inc. or the names of contributors 
\ may be used to endorse or promote products derived from this software 
\ without specific prior written permission. 
\ 
\     This software is provided "AS IS," without a warranty of any kind. 
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES, 
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A 
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN 
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR 
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR 
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN 
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR 
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE 
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY, 
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF 
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\ 
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ any nuclear facility. 
\ 
\ ========== Copyright Header End ============================================
id: @(#)keystore.fth 1.3 06/11/22
purpose: 
copyright: Copyright 2006 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

headerless

0 value keystore-ihandle
0 value keystore-buf		\ Cached data
0 value /keystore		\ Size of keystore partition

alias keystore-ready? keystore-ihandle

struct
   /w  field  >keystore-magic
   /w  field  >keystore-len	\ Keystore data length, including header
   /w  field  >keystore-crc
constant /keystore-header

: keystore-len@ ( -- n )   keystore-buf >keystore-len w@ ;
: keystore-len! ( n -- )   keystore-buf >keystore-len w! ;

: keydata-start@ ( -- adr )  keystore-buf /keystore-header + ;
: keydata-end@   ( -- adr )  keystore-buf keystore-len@ + ;

: keyrecord-len@ ( adr -- n )  dup count ca+ count ca+ swap - ;

: keystore-open ( -- ihandle | 0 )
   d# 256 dup alloc-mem swap  over >r		( va len ) ( r: va ) 
   0 r@ c!					( va len )
   nvram-package phandle>devname  r@ $cat	( va len )
   " :keys"                       r@ $cat	( va len )
   r> count open-dev				( va len ihandle ) ( r: )
   -rot  free-mem				( ihandle )
;

: $call-keystore-method ( ?? method$ -- ?? )  keystore-ihandle $call-method  ;

: keystore-seek ( offset -- )  0 " seek" $call-keystore-method throw ;

: keystore-read ( adr len -- )
   keystore-ihandle 0=  if  2drop exit  then
   tuck " read" $call-keystore-method <>  throw
;

: keystore-write ( adr len -- )
   keystore-ihandle 0=  if  2drop exit  then
   tuck " write" $call-keystore-method <>  throw
;

: (keystore-crc) ( accumulator adr len -- n )
   bounds ?do  i c@ +  wbsplit +  loop
;

: keystore-crc ( -- crc )
   keystore-buf keystore-len@				( adr len )
   2dup wbsplit +  swap /w 2*  (keystore-crc)  -rot	( n adr len )
   /keystore-header tuck - >r + r>  (keystore-crc)	( crc )
;

: keystore-sync ( -- )
   0 keystore-seek					( )
   keystore-crc  keystore-buf tuck >keystore-crc  w!	( adr )
   dup >keystore-len w@  keystore-write			( )
;

: keystore-init ( -- )
   keystore-buf dup /keystore erase			( adr )
   h# cd63           over >keystore-magic  w!		( adr )
   /keystore-header  swap >keystore-len    w!		( )
   keystore-sync					( )
;

: init-keystore-partition ( -- )
   keystore-ihandle if  exit  then				( )

   keystore-open  dup is keystore-ihandle  0=  if		( )
      cmn-error[ " Could not open security keystore device" ]cmn-end 
      -1 throw
   then								( )

   " size" $call-keystore-method  dup is /keystore		( size )
   dup alloc-mem tuck swap erase  is keystore-buf		( )

   0 keystore-seek						( )
   keystore-buf /keystore-header keystore-read			( )
   keystore-buf >keystore-magic w@  h# cd63 <>	if		( )
      cmn-note[ " Initializing security keystore" ]cmn-end
      keystore-init exit						( )
   then								( )

   keydata-start@ keydata-end@ over -				( adr len )
   ['] keystore-read catch 0=  if				( )
      keystore-buf >keystore-crc w@  keystore-crc =  if		( )
         exit							( )
      then							( )
   else								( adr len )
      2drop 							( )
   then								( )
   cmn-error[
      " Security keystore contents corrupt; Reinitializing keystore"
   ]cmn-end
   keystore-init						( )
;

\ Locate the named key in keystore.
: find-security-key ( key$ -- adr | 0 )
   2>r						( ) ( r: key$ )
   keydata-end@  keydata-start@			( end start )
   begin  2dup >  while				( end nxt )
      dup count	 2dup 2r@ $=  if		( end nxt $ )
         2drop nip 2r> 2drop exit		( nxt ) ( r: )
      else					( end nxt $ )
         rot drop  ca+ count ca+		( end nxt' )
      then					( end nxt' )
   repeat  2drop				( )
   2r> 2drop 0					( 0 ) ( r: )
;

\ Add a key record entry.
: add-keyrecord-entry ( name,len data,len -- )
   keydata-end@ >r				( name,len data,len ) ( r: adr )
   2swap  r@ pack count ca+  pack count ca+	( adr' )
   r> -  keystore-len@ +  keystore-len!		( ) ( r: )
;

\ Delete a keyrecord entry
: delete-keyrecord-entry ( adr -- )
   dup keyrecord-len@  dup >r				( adr n ) ( r: n )
   over ca+  keydata-end@  over - rot swap move		( )
   keystore-len@  r> -	keystore-len!			( ) ( r: )
;

\ Check keystore space availability.
: enough-key-room? ( name,len keydata,len -- flag )
   nip over +  2+ >r				( name,len ) ( r: total )
   /keystore  keystore-len@ -  			( name,len nfree )
   -rot  find-security-key ?dup if		( nfree keyrecord-adr )
      count tuck ca+ count nip +  2+  +		( avail )
   then						( avail )
   r> >=					( flag ) ( r: )
;

d# 64  constant  max-keyname-len	\ Keyname can be upto 64 characters
d# 32  constant  max-keydata-len	\ Keydata can be upto 32 bytes

\ Key retrieval. Returns length of the key on success, or one of the 
\ following codes on failure:
\	-1	Invalid argument (Key name too long)
\	-2	Buffer too small to hold key data
\	-3	Key does not exist
\	-4	Could not access keystore

: (get-security-key) ( key$ -- keydata,len )
   find-security-key ?dup  if  count ca+ count	else  0 0  then
;

cif: SUNW,get-security-key ( len buf cname -- keylen | error# )
   >r swap r> cscount				( buf len keyname$ )
   dup max-keyname-len >  if			( buf len keyname$ )
      2drop 2drop -1 exit
   then						( buf len keyname$ )
   keystore-ready? 0=  if			( buf len keyname$ )
      2drop 2drop -4 exit
   then						( buf len keyname$ )
   (get-security-key) dup 0=  if		( buf len keydata keylen )
      2drop 2drop -3 exit
   then						( buf len keydata keylen )
   rot	over <  if				( buf keydata keylen )
      3drop -2 exit
   then						( buf keydata keylen )
   dup >r  rot swap move  r>			( keylen )
;

[ifdef] SUN4V
: init-ldoms-keystore-partition ( -- )
    h# 100 dup is /keystore				( size )
    dup alloc-mem tuck swap erase dup is keystore-buf	( adr )     
    h# cd63           over >keystore-magic  w!		( adr )
    /keystore-header  swap >keystore-len    w!		( )
    true to keystore-ready?
;

d# 64  buffer:  hexascii-buf

\ Get ASCII hexadecimal representation of octet stream 
: key>ascii ( data datalen -- buf buflen )
   hexascii-buf 0  2swap				( buf 0 data datalen )
   dup 0=  over d# 32 >  or  if				( buf 0 data datalen )
      2drop exit					( buf 0 )
   then							( buf 0 data datalen )
   base @ >r  hex					( buf 0 data datalen )
   bounds ?do						( buf len )
      i c@  <# u# u# u#>				( buf len $ )
      2over ca+  swap move				( buf len )
      2+						( buf len' )
   loop							( buf len' )
   2dup upper						( buf len' )
   r> base !						( buf buflen )
;

\ These words are called if the keystore domain-service has not yet
\ been attached (when first loading the keystore MD node)
: no-ds-set  ( data,len name,len -- )  2drop 2drop  ;
: no-ds-unset  ( name,len -- )  2drop  ;

defer key-set 		['] no-ds-set   is key-set
defer key-delete   	['] no-ds-unset is key-delete

\ #### sync is needed so we can switch back and forth between
\ #### domain service and svc-channel.  It will be removed
defer key-sync		['] noop is key-sync

\ Store security key in keystore.
: write-security-key ( name,len data,len -- keylen )
   2over find-security-key ?dup if		( name,len data,len adr )
      delete-keyrecord-entry			( name,len data,len )
   then						( name,len data,len )
   dup if					( name,len data,len )
      2over 2over key>ascii 2swap key-set	( name,len data,len )
      dup >r  add-keyrecord-entry  r>		( keylen )
   else						( name,len data,len )
      2drop key-delete 0			( 0 )
   then						( keylen )
   key-sync
;
[else]
\ Store security key in keystore.
: write-security-key ( name,len data,len -- keylen )
   2over find-security-key ?dup if		( name,len data,len adr )
      delete-keyrecord-entry			( name,len data,len )
   then						( name,len data,len )
   dup if					( name,len data,len )
      dup >r  add-keyrecord-entry  r>		( keylen )
   else						( name,len data,len )
      2drop 2drop 0				( 0 )
   then						( keylen )
   keystore-sync				( keylen )
;
[then]


\ Key storage/deletion. A key length of zero is used to delete the
\ named key. On success, the length of stored key is returned; a return
\ value of zero indicates successful key deletion. Possible error 
\ return values are
\	-1	Invalid arguments (Key name or value too long)
\	-2	Key to delete does not exist
\	-3	Out of key storage space
\	-4	Could not access keystore
 
: (set-security-key) ( name,len data,len -- len' | error# )
   2 pick max-keyname-len >  over max-keydata-len >  or  if
      2drop 2drop -1 exit
   then						( name,len data,len )
   keystore-ready? 0=  if
      2drop 2drop -4 exit
   then						( name,len data,len )
   dup 0=  if
      2over find-security-key 0=  if
         2drop 2drop -2 exit
      then
   then						( name,len data,len )
   2over 2over enough-key-room? 0=  if
      2drop 2drop -3 exit
   then						( name,len data,len )
   write-security-key
;

cif: SUNW,set-security-key ( len buf cname -- len' | error# )
   >r swap r> cscount 2swap (set-security-key)
;

max-keydata-len  buffer:  keydata-buf	\ Buffer to hold raw keydata

: convert-key ( keyvalue$ -- [ keydata datalen ] valid? )
   dup 2 mod 0<>  over 2/ max-keydata-len >  or  if	( keyvalue$ )
      2drop false exit					( false )
   then							( keyvalue$ )
   keydata-buf 0  2swap bounds ?do			( keydata,len )
      i 2 $hnumber if					( keydata,len )
         2drop false unloop exit			( false )
      then						( keydata,len n )
      >r  2dup ca+  r> swap c!				( keydata,len )
      1+						( keydata,len' )
   2 +loop  true					( keydata,len' true )
;

headers
also forth definitions

\ Command line interface to store/delete security keys.
: set-security-key  \ keyname keyvalue ( -- )
   safe-parse-word  parse-word  dup if		( name$ value$ )
      2dup convert-key 0=  if			( name$ value$ )
         ." Invalid keyvalue '" type ." '" cr
         2drop exit				( )
      else					( name$ value$ keydata,len )
         2swap 2drop				( name$ keydata,len )
      then					( name$ keydata,len )
   then						( name$ keydata,len )
   2over 2over (set-security-key)		( name$ keydata,len result )
   dup 0<  if					( name$ keydata,len error# )
      case
         -1  of  ." Key name or value too long"    endof
         -2  of  ." Key to delete does not exist"  endof
         -3  of  ." Out of key storage space"      endof
         -4  of  ." Could not update key data"     endof
      endcase					( name$ keydata,len )
      2drop 2drop				( )
   else						( name$ keydata,len len' )
      drop nip 0=  if				( name$ )
         ." Key '"  2dup type ." ' deleted" cr	( name$ )
      then  2drop				( )
   then						( )
;

\ List names of keys stored in the keystore. Key values are not printed. 
: list-security-keys ( -- )
   keydata-end@ keydata-start@ 				( end start )
   begin  2dup >  while					( end nxt )
      dup count type cr  dup keyrecord-len@ ca+		( end nxt' )
   repeat  2drop					( )
;

previous

stand-init: initialize security key structure
[ifdef] SUN4V
   init-ldoms-keystore-partition
[else]
   init-keystore-partition
[then]
;