\ ========== 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
\ - 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
\ ========== Copyright Header End ============================================
id: @(#)keystore.fth 1.4 07/04/10
copyright: Copyright 2007 Sun Microsystems, Inc. All Rights Reserved
copyright: Use is subject to license terms.
also keystore definitions
h# 4f42504b4559 value key-svc-handle \ OBPKEY
\ Keystore Updates Response
/l field >key-updates-response
/l field >key-updates-size
constant /key-updates-hdr
/key-hdr /key-response + constant /key-response-pkt
d# 1024 constant MAX-VAR-SIZE
MAX-VAR-SIZE /key-hdr + buffer: key-buf
MAX-DS-PAYLOAD constant MAX-UPDATES-SIZE \ that OBP can currently handle
0 value keystore-updates-buf \ allocated on the fly for MD updates
0 value keystore-backup? \ Differentiate between the two services
: key-cmd! ( cmd pkt -- ) >key-cmd l! ;
: key-cmd@ ( pkt -- cmd ) >key-cmd l@ ;
: >key-payload ( pkt -- payload-adr ) /key-hdr + ;
: key-response@ ( pkt -- response ) >key-payload >key-response l@ ;
: >key-updates-payload ( pkt -- payload-adr )
>key-payload /key-updates-hdr +
: keystore-updates-size@ ( pkt -- size ) /key-hdr + >key-updates-size l@ ;
0 constant KEYSTORE-SET-REQ
1 constant KEYSTORE-DELETE-REQ
2 constant KEYSTORE-SET-RESP
3 constant KEYSTORE-DELETE-RESP
4 constant KEYSTORE-UPDATES-REQ
5 constant KEYSTORE-UPDATES-RESP
0 constant KEYSTORE-SUCCESS
1 constant KEYSTORE-NO-SPACE
2 constant KEYSTORE-INVALID-KEY
3 constant KEYSTORE-INVALID-VAL
4 constant KEYSTORE-NOT-PRESENT
\ To coordinate handoffs between Solaris and OBP the state of the
\ domain-service channel is stored away. If OBP needs to use the channel
\ after it has been closed it will attempt to re-register its needed service
KEY-CLOSED value key-service-state
\ Domain-service interfaces
\ Send buffer on the given service channel
: send-ds-data ( buf len svc-handle -- error? )
[ also domain-services ] send-ds-data [ previous ]
\ Receive a packet of at most len from the given service channel
: receive-ds-data ( buf len svc-handle -- len' 0 | error )
[ also domain-services ] receive-ds-data [ previous ]
\ Attempt to register $svc-id with svc-handle. Returns error/ack/nack
: register-domain-service ( maj min svc-han $svc-id -- maj/min ack? 0 | -1 )
[ also domain-services ] register-domain-service [ previous ]
\ Unregister the domain service negotiated on svc-handle
: unregister-domain-service ( svc-handle -- error? )
[ also domain-services ] unregister-domain-service [ previous ]
\ service IDs with Null Character embedded
: $keystore ( -- $ ) " keystore"(00)" ;
: $keystore-backup ( -- $ ) " keystore-backup"(00)" ;
\ Both init-primary-service and init-secondary-service can be changed
\ to begin/while loops with multiple calls to reigster-domain-service
\ however right now we only support 1.0 so if we get a nack that's it.
: init-primary-service ( -- error? )
key-major key-minor key-svc-handle $keystore
register-domain-service ?dup 0= if ( maj/min ack? )
dup 0= if 0 to keystore-backup? then
: init-secondary-service ( -- error? )
key-major key-minor key-svc-handle $keystore-backup
register-domain-service ?dup 0= if ( maj/min ack? )
dup 0= if -1 to keystore-backup? then
\ Attempt to Register one of the two keystore services
init-primary-service dup if ( error? )
drop init-secondary-service ( error? )
KEY-CLOSED to key-service-state
KEY-OPEN to key-service-state
\ Unregister the keystore service
key-service-state KEY-OPEN <> if exit then ( )
key-svc-handle unregister-domain-service ?dup if ( )
\ If LDC is not up then it has been reset, treat this as closed LDC
\ which can be re-opened for later operations.
KEY-CLOSED to key-service-state ( )
KEY-ERROR to key-service-state ( )
KEY-CLOSED to key-service-state ( )
key-svc-handle 1+ to key-svc-handle \ new handle in case of re-register
\ Bring up the keystore channel unless it is in the ERROR state
: check-key-channel-state ( -- error? )
KEY-CLOSED of key-init endof
\ Store string as a null-terminated string and return pointer past the
\ terminating null character.
: $cstrput ( str len dest-adr -- end-adr )
swap 2dup ca+ >r move 0 r@ c! r> ca1+
\ " foo" " bar" becomes " foo"(00)"bar"(00)"
: cat-with-nulls ( str len str2 len2 -- str' len' )
str-buf $cstrput $cstrput drop
: to-cstr ( buf len -- buf' len' )
tuck str-buf $cstrput drop ( len )
str-buf swap 1+ ( buf len' )
\ Wrap set data in a keystore packet to be sent to the domain services layer
: assemble-set-pkt ( $data $name -- pkt len )
cat-with-nulls tuck key-buf ( $payload pkt )
KEYSTORE-SET-REQ over key-cmd! ( payload-len $payload pkt )
>key-payload swap move ( payload-len )
key-buf swap /key-hdr + ( pkt len )
\ Wrap unset data to be sent to the domain services layer
: assemble-unset-pkt ( $name -- pkt len )
to-cstr tuck key-buf ( name-len $name pkt )
KEYSTORE-DELETE-REQ over key-cmd! ( name-len $name pkt )
>key-payload swap move ( name-len )
key-buf swap /key-hdr + ( pkt len )
\ Request any updates from the SP since it last created an MD
: assemble-updates-req-pkt ( -- pkt len )
keystore-updates-buf ( pkt )
KEYSTORE-UPDATES-REQ over key-cmd! ( pkt )
: key-response? ( cmd -- key-response? )
dup KEYSTORE-DELETE-RESP = swap KEYSTORE-SET-RESP = or
: key-updates-response? ( cmd -- ldv-updates-response? )
\ Wait for keystore response request
: wait-for-key-response ( -- error )
dup /key-response-pkt key-svc-handle ( buf buf len handle )
receive-ds-data ?dup if ( buf len' | buf error )
cmn-warn[ " Waiting for key response but LDC is Not Up!" ]cmn-end
\ Mark the service closed so that it can be opened again
KEY-CLOSED to key-service-state ( )
/key-response-pkt <> if ( buf )
" No Keystore response from Domain Service Providor "
dup key-cmd@ key-response? ( buf response? )
KEYSTORE-SUCCESS of 0 endof
KEYSTORE-NO-SPACE of " No Space" endof
KEYSTORE-INVALID-KEY of " Invalid Key Name" endof
KEYSTORE-INVALID-VAL of " Invalid Value" endof
KEYSTORE-NOT-PRESENT of " Key not Present" endof
\ The updates response could be large. The domain-service interface layer
\ should be updated to handle variable length packets until it is, we default
\ to the current max size of an OBP domain-service packet (8K)
: wait-for-updates-response ( -- error )
keystore-updates-buf ( buf )
dup MAX-UPDATES-SIZE key-svc-handle ( buf buf len handle )
receive-ds-data ?dup if ( buf len' | buf error )
dup LDC-NOTUP = if ( buf error )
" Waiting for Keystore Response but LDC is Not Up!"
\ Mark the service closed so that it can be opened again
KEY-CLOSED to key-service-state ( )
dup key-cmd@ key-updates-response? ( buf response? )
keystore-updates-size@ MAX-UPDATES-SIZE > dup if
cmn-warn[ " Keystore error - Updates MD too large " ]cmn-end
: keystore-set ( $data $name -- )
check-key-channel-state if
cmn-warn[ " Unable to store Security key" ]cmn-end
assemble-set-pkt ( pkt len )
key-svc-handle send-ds-data ?dup if ( | status )
cmn-warn[ " Sending Keystore Set request but LDC is Not Up!" ]cmn-end
\ Mark the service closed so that it can be opened again
KEY-CLOSED to key-service-state ( )
cmn-warn[ " Keystore Set request failed!" ]cmn-end
cmn-warn[ " Unable to store security key" ]cmn-end
: keystore-delete ( $name -- )
check-key-channel-state if
cmn-warn[ " Unable to Delete Security key" ]cmn-end
assemble-unset-pkt ( buf len )
key-svc-handle send-ds-data ?dup if ( | status )
cmn-warn[ " Sending Keystore Delete request but LDC is Not Up!" ]cmn-end
\ Mark the service closed so that it can be opened again
KEY-CLOSED to key-service-state ( )
cmn-warn[ " Keystore Delete request failed!" ]cmn-end
cmn-warn[ " Unable to Delete security key" ]cmn-end
\ Get the next string property in MD node
: get-next-str-prop ( node prop -- ent|0 )
over swap md-next-prop dup ( node prop,prop|0,0 )
dup md-prop-type ascii s = if ( node prop )
\ Load security keys from the "keystore" MD node. We do this before
\ initializing the domain service to avoid redundant keystore-set calls
0 " keystore" md-find-node ?dup 0= if exit then
over swap get-next-str-prop ?dup ( [ node prop prop ] | [ node 0 ] )
dup md-decode-prop drop ( node prop $data )
2 pick md-prop-name ( node prop $data $name )
2swap convert-key drop ( node prop $name data,len )
(set-security-key) drop ( node prop )
\ Load keystore updates from a mini MD
\ 1. Set keys as they appear under the keystore node
\ 2. If the entry name is the reserved word "_delete"... delete the given
\ in the property data field
keystore-updates-buf >key-updates-payload md-set-working-md
0 " keystore" md-find-node ?dup if
over swap get-next-str-prop ?dup ( [ node prop prop ] | [ node 0 ] )
dup md-decode-prop drop ( node prop $data )
2 pick md-prop-name ( node prop $data $name )
2dup " _delete" $= if ( node prop $data $name )
drop 0 (set-security-key) ( node prop error? )
2swap convert-key drop ( node prop $name data,len )
(set-security-key) drop ( node prop )
0 md-set-working-md \ This Line is VERY IMPORTANT
\ Request a "mini'MD" from the SP that contains any changes to the
\ keystore MD node since it last created a guest MD
: get-keystore-updates ( -- )
check-key-channel-state if
\ Only meaningful when talking to the SP
MAX-UPDATES-SIZE alloc-mem to keystore-updates-buf
assemble-updates-req-pkt ( pkt len )
key-svc-handle send-ds-data ?dup if ( | status )
" Sending Keystore Update request but LDC is Not Up!"
\ Mark the service closed so that it can be opened again
KEY-CLOSED to key-service-state ( )
cmn-warn[ " Error sending Keystore Updates request" ]cmn-end
keystore-updates-buf MAX-UPDATES-SIZE free-mem
wait-for-updates-response 0= if ( )
keystore-updates-buf MAX-UPDATES-SIZE free-mem
stand-init: Security Key Domain Service Init
['] keystore-set is key-set
['] keystore-delete is key-delete
projects / OpenSPARC-T2-SAM / blob