[openfirmware] [commit] r3016 - cpu/x86/pc/olpc
repository service
svn at openfirmware.info
Thu Jun 21 02:03:10 CEST 2012
Author: wmb
Date: Thu Jun 21 02:03:09 2012
New Revision: 3016
URL: http://tracker.coreboot.org/trac/openfirmware/changeset/3016
Log:
OLPC - checked in oatstime.fth - a script that can be signed and
used to set the Real Time Clock on secure machines.
Added:
cpu/x86/pc/olpc/oatstime.fth
Added: cpu/x86/pc/olpc/oatstime.fth
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cpu/x86/pc/olpc/oatstime.fth Thu Jun 21 02:03:09 2012 (r3016)
@@ -0,0 +1,392 @@
+\ OLPC boot script to set the XO system time from an OATS server
+\ This can be signed and booted on secure machines to fix their clocks
+
+\ Set this to the name or IP address of the deployment's OATS server
+: server$ " 192.168.200.57" ; \ DNS name or IP address
+
+\ Replace this key with a deployment-specific one
+create oats-pubkey
+ " "(30 82 01 0a 02 82 01 01 00 cf 2c 9a 49 81 a9 dd)" $,
+ " "(0e 39 e6 02 dc 9a 77 2e 9e cb 24 0c 1d 94 ec d3)" $,
+ " "(e9 0a 86 58 fb c4 a1 f7 dd 06 d4 87 03 c3 04 8f)" $,
+ " "(43 25 a9 27 62 9b 58 71 e2 39 f6 d5 55 35 37 d4)" $,
+ " "(23 14 2a 10 fa b7 2f ad 4c d1 5c 9f c8 87 10 25)" $,
+ " "(28 fd 72 b1 c6 87 8e 55 bd 77 a8 a4 84 d6 4a 41)" $,
+ " "(7d 36 f2 7b 8e c3 67 3f d8 78 a5 69 10 86 b8 48)" $,
+ " "(08 17 74 f9 7a 17 e3 9e c6 8a 41 bc 21 b8 1f 9d)" $,
+ " "(02 e3 82 31 96 28 b8 92 b4 2b c0 10 c6 c5 8d d5)" $,
+ " "(1b 2b 4b e1 cd 3d 21 76 1d 83 0a 65 88 ce 49 ad)" $,
+ " "(8f 85 40 7a 16 d7 99 24 6b 72 5c f9 eb af b8 f9)" $,
+ " "(d5 3d ed 90 5f 95 b0 51 8a b3 ed 16 8a 07 2a 89)" $,
+ " "(ae 7f da 04 c8 14 01 86 04 ce 33 a6 3f 39 ce 79)" $,
+ " "(bf af d4 81 e3 c6 1f 57 06 25 4f 3f 24 f7 28 38)" $,
+ " "(6d 8b 34 5e fe da 86 cd 0f 9a 17 99 a7 c6 b2 57)" $,
+ " "(ab 76 47 54 cb 11 a4 47 e0 9c 5e fa f1 2c 59 68)" $,
+ " "(26 73 1e 7b 20 e8 9c 89 ab 02 03 01 00 01)" $,
+here oats-pubkey - constant oats-pubkey-len
+
+\ Canonical JSON parser
+
+\ Look at the next character in the JSON stream, leaving it in the stream
+: json-look ( rem$ -- rem$ char )
+ dup 0<= abort" Unexpected end of CJSON data"
+ over c@
+;
+
+\ Discard the next character in the JSON stream
+: json-skip ( rem$ -- rem$' ) ( over c@ emit ) 1 /string ;
+
+\ Get the next character from the JSON stream
+: json-get ( rem$ -- rem$' char ) json-look >r json-skip r> ;
+
+\ Get the next JSON character and abort if is not the expected one
+: json-expect ( rem$ char -- rem$' )
+ >r json-get r> <> abort" Unexpected character in CJSON stream"
+;
+
+\ True if there is another object element
+: json-element? ( rem$ -- rem$' flag )
+ json-look case
+ [char] ] of false endof
+ [char] , of json-skip true endof
+ ( default ) true swap
+ endcase
+;
+
+: json-[ ( rem$ -- rem$' ) [char] [ json-expect ; \ Expect [ - start of array
+: json-] ( rem$ -- rem$' ) [char] ] json-expect ; \ Expect ] - end of array
+: json-, ( rem$ -- rem$' ) [char] , json-expect ; \ Expect , - another array element
+
+\ Collect digits to form a nonnegative number
+: json-digits ( rem$ -- rem$' n )
+ 0 begin
+ >r
+ json-look dup [char] 0 [char] 9 between if
+ [char] 0 - r> d# 10 * + >r
+ json-skip
+ else
+ drop r> exit
+ then
+ r>
+ again
+;
+
+\ Collect a (possibly negative) number
+: json-number ( rem$ -- rem$' n )
+ json-look [char] - = if
+ json-skip json-digits negate
+ else
+ json-digits
+ then
+;
+
+: cjson-copy-escaped ( adr len dest-adr -- dest$ )
+ 0 2swap bounds ?do ( dest-adr dest-len )
+ i c@ dup [char] \ = if ( dest-adr dest-len char )
+ drop ( dest-adr dest-len )
+ else ( dest-adr dest-len char )
+ 2 pick 2 pick + c! ( dest-adr dest-len )
+ 1+ ( dest-adr dest-len' )
+ then ( dest-adr dest-len )
+ loop ( dest-adr dest-len )
+;
+
+\ Collect a string. Escape sequences are left in place - not converted -
+\ to avoid the need for memory allocation. Use cjson-copy-escaped if
+\ you need to process escapes.
+: json-" ( rem$ -- rem$' $ )
+ [char] " json-expect ( rem$ )
+ over 0 ( rem$ $ )
+ begin ( rem$ $ )
+ 2>r
+ json-look ( rem$ char r: $ )
+ case
+ [char] " of ( rem$ )
+ json-skip ( rem$' )
+ 2r> exit
+ endof
+ [char] \ of ( rem$ )
+ json-skip
+ json-get
+ 2r> 1+ 2>r
+ endof
+ ( default ) >r json-skip r>
+ endcase
+ 2r> 1+
+ again
+;
+
+: json-{ ( rem$ -- rem$' ) [char] { json-expect ; \ Expect { - start of object
+: json-} ( rem$ -- rem$' ) [char] } json-expect ; \ Expect } - end of object
+: json-: ( rem$ -- rem$' ) [char] : json-expect ; \ Expect : - object value
+
+\ True if there is another object pair
+: json-pair? ( rem$ -- rem$ flag )
+ json-look case
+ [char] } of false endof
+ [char] , of json-skip true endof
+ ( default ) true swap
+ endcase
+;
+
+\ Expect a literal string - implementation factor
+: json$ ( rem$ $ -- rem$' ) bounds ?do i c@ json-expect loop ;
+
+: json-true ( rem$ -- rem$' ) " true" json$ ; \ Expect literal 'true'
+: json-false ( rem$ -- rem$' ) " false" json$ ; \ Expect literal 'false'
+: json-null ( rem$ -- rem$' ) " null" json$ ; \ Expect literal 'null'
+
+\ Parse and discard a value - useful for skipping the value portion of uninteresting pairs
+\ Forward referenced because arrays can contain values and values can be arrays
+defer discard-json-value
+
+\ Parse and discard an array - factor of discard-json-value
+: discard-json-array ( rem$ -- rem$' )
+ json-[ ( rem$' )
+ begin json-element? while ( rem$' )
+ discard-json-value ( rem$' )
+ repeat ( rem$' )
+ json-] ( rem$' )
+;
+
+\ Parse and discard an object - factor of discard-json-value
+: discard-json-object ( -- )
+ json-{ ( rem$' )
+ begin json-pair? while ( rem$' )
+ json-" 2drop ( rem$' )
+ json-: ( rem$' )
+ discard-json-value ( rem$' )
+ repeat ( rem$' )
+ json-} ( rem$' )
+;
+
+\ Helper function used with Forth case statement to match a range of values
+: range ( selector low high -- selector n )
+ 2>r dup 2r> between if dup else dup invert then ( selector n )
+;
+
+\ Final implementation of the forward-referenced "discard-json-value"
+: (discard-json-value) ( rem$ -- rem$' )
+ json-look case
+ [char] " of json-" 2drop endof
+ [char] t of json-true endof
+ [char] f of json-false endof
+ [char] n of json-null endof
+ [char] [ of discard-json-array endof
+ [char] { of discard-json-object endof
+ [char] - of json-number drop endof
+ [char] 0 [char] 9 range of json-number endof
+ ( default )
+ true abort" Invalid first character in JSON value"
+ endcase
+;
+' (discard-json-value) to discard-json-value
+
+\ End of generic canonical JSON code
+
+\ Expect an envelope of the given name and version, leaving the CJSON
+\ stream remainder at the enveloped contents
+: envelope( ( rem$ name$ version -- rem$' )
+ >r 2>r ( rem$ r: version name$ )
+ json-[ ( rem$' r: version name$ )
+ json-" ( rem$' $ r: version name$ )
+ 2r> $= 0= abort" Wrong envelope" ( rem$' r: version )
+ json-,
+ json-number ( rem$' n r: version )
+ r> <> abort" Wrong envelope version" ( rem$' )
+ json-, ( rem$ )
+ \ remainder starts with the envelope data
+;
+
+\ Expect the end of an envelope
+: )envelope ( rem$ -- rem$' ) json-] ;
+
+
+d# 256 buffer: nonce-data
+: save-nonce ( rem$ -- rem$' )
+ json-" ( rem$' value$ )
+ d# 255 min nonce-data 1+ cjson-copy-escaped ( rem$ $ )
+ nonce-data c! drop ( rem$ )
+;
+
+d# 32 buffer: time-data
+: save-time ( rem$ -- rem$' )
+ json-" ( rem$' value$ )
+ d# 31 min time-data 1+ cjson-copy-escaped ( rem$ $ )
+ time-data c! drop ( rem$ )
+;
+
+: decode-oats-key ( rem$ name$ -- rem$' )
+ json-" ( rem$ name$ )
+ 2dup " nonce" $= if ( rem$ name$ )
+ 2drop ( rem$ )
+ json-: ( rem$' )
+ save-nonce ( rem$' )
+ exit ( -- rem$ )
+ then ( rem$ name$ )
+ 2dup " time" $= if ( rem$ name$ )
+ 2drop ( rem$ )
+ json-: ( rem$' )
+ save-time ( rem$' )
+ exit ( -- rem$ )
+ then ( rem$ name$ )
+ 2drop ( rem$ )
+ json-: ( rem$' )
+ discard-json-value ( rem$' )
+;
+: decode-oats-data ( rem$ -- rem$' )
+ " oatc-resp" 1 envelope( ( rem$' )
+
+ \ Enveloped data is an object { "nonce":value, "time":value, ... }
+ json-{ ( rem$' )
+ begin json-pair? while ( rem$' )
+ decode-oats-key ( rem$' )
+ repeat ( rem$ )
+ json-} ( rem$' )
+
+ )envelope ( rem$' )
+;
+
+0 0 2value the-signature$
+: decode-oats-credential ( rem$ -- rem$' )
+ " sig" 1 envelope( ( rem$' )
+
+ \ Enveloped data is an array of signatures - [ "sig01 ...", ... ]
+ json-[ ( rem$' )
+ begin json-element? while ( rem$' )
+ json-" ( rem$ sig$ )
+ to the-signature$ ( rem$' )
+ repeat ( rem$ )
+ json-] ( rem$' )
+
+ )envelope ( rem$' )
+;
+
+: decode-oats-response ( rem$ -- rem$' )
+ " oatc-signed-resp" 1 envelope( ( rem$' )
+ \ Enveloped data is a 2-element array - [data,credential]
+
+ json-[ ( rem$' )
+ over >r ( rem$ r: data-adr )
+ decode-oats-data ( rem$' r: data-adr )
+ r> 2 pick over - to signed-data$ ( rem$' )
+ json-, ( rem$' )
+ decode-oats-credential ( rem$' )
+ json-] ( rem$' )
+
+ )envelope ( rem$' )
+;
+
+0 [if] \ Example request
+POST /antitheft/1/ HTTP/1.1
+Host: antitheft.laptop.org
+Content-Type: application/x-www-form-urlencoded
+Content-Length: 43
+
+serialnum=SHC12900018&version=1&nonce=12345678
+[then]
+
+0 [if] \ Example response
+["oatc-signed-resp",1,[["oatc-resp",1,{"nonce":"12345678
+","time":"20120619T144129Z"}],["sig",1,["sig01: sha256 b257ab764754cb11a447e09c5efaf12c596826731e7b20e89c89ab0203010001 8200ecb1b71df1119fceba00e8cca7b29b6e2870c7ab6224ca49e8a4a57b295edc733646ec5ae36767a403ebd43217185a46bb6d41c32f2d7ce4c33de6c4718a5e87e28349e9f72be719d6fcea35a37a3b68afc3b8a42d58333e7c6e78e1bb6f87dd106dce69dc191e1598514b63645f17a77be36128601950146c87b8702ba3474fc2289a589e38929f532cae683d6094171f7afa2c1765592216bdaa6c975916810b61db83a4a6f0a1b17f3f69559d45aebf64bb1c324fda2e97a044840556bfa688097ae77823447b07cdd5fce2f96bf990b11d7e6c409df2c42272d33805fb6fcdaa0ffd4d1b1ebeef44f458f1201fb484a43b4d10932862a3eba0b021e5
+"]]]]
+[then]
+
+0 value http-ih
+: $call-http http-ih $call-method ;
+dev /http
+\needs flush-writes : flush-writes " flush-writes" $call-parent ;
+\needs connect : connect " connect" $call-parent ;
+dend
+: http-write " tcp-write" $call-http ;
+: http-write-line ( adr len -- ) http-write " "r"n" http-write ;
+: http-read-line ( -- adr len ) " get-line" $call-http ;
+
+: oats-send ( msg$ -- )
+ server$ " set-server" $call-http
+ d# 80 " connect" $call-http 0= abort" Can't connect to server"
+ " POST /antitheft/1/ HTTP/1.1" http-write-line
+ " Host: antitheft.laptop.org" http-write-line
+ " Content-Type: application/x-www-form-urlencoded" http-write-line
+ dup " Content-Length: %d" sprintf http-write-line ( msg$ )
+ " " http-write-line ( msg$ )
+ http-write
+ " flush-writes" $call-http
+;
+0 value the-nonce
+: oats-msg$ ( -- msg$ )
+ random-long abs dup to the-nonce ( nonce )
+ " SN" find-tag 0= abort" Machine has no serial number" ?-null ( nonce sn$ )
+ " serialnum=%s&version=1&nonce=%d" sprintf
+;
+h# 10000 buffer: oats-buf
+: tread
+ oats-buf h# 10000 " wait-read" $call-http dup 0> if oats-buf swap list else drop then
+;
+: open-http http-ih 0= if " http:" open-dev to http-ih then ;
+: close-http http-ih if http-ih close-dev 0 to http-ih then ;
+
+: decimal-number ( $ -- n )
+ push-decimal $number abort" Bad number" pop-base
+;
+
+: (parse-time) ( $ -- s m h d m y )
+ d# 20 d# 20 numfield >r ( rem$ r: century )
+ d# 12 d# 40 numfield r> d# 100 * + >r ( rem$ r: y )
+ d# 1 d# 12 numfield >r ( rem$ r: y m )
+ d# 1 d# 31 numfield >r ( rem$ r: y m d )
+
+ 1 cut$ " T" $= 0= abort" Expecting T in time"
+ d# 0 d# 24 numfield >r ( rem$ r: y m d h )
+ d# 0 d# 59 numfield >r ( rem$ r: y m d h m )
+ d# 0 d# 59 numfield >r ( rem$ r: y m d h m s )
+
+ 1 cut$ " Z" $= 0= abort" Expecting T in time" ( rem$ r: y m d h m s )
+ 0<> abort" Junk after time" drop ( r: y m d h m s )
+ r> r> r> r> r> r>
+;
+: parse-time ( $ -- s m h d m y )
+ push-decimal ['] (parse-time) catch pop-base throw
+;
+: verify-oats ( rem$ -- )
+ dup if ." Extra stuff after OATS response: " list cr else 2drop then ( )
+
+ nonce-data count decimal-number the-nonce <> abort" Nonce mismatch"
+
+ oats-pubkey-len to pubkeylen
+ oats-pubkey oats-pubkey-len to pubkey$
+ " sha256" to exp-hashname$
+ the-signature$ begin dup while ( rem$ )
+ newline left-parse-string ( rem$ line$ )
+ this-sig-line-good? 0= abort" Bad signature"
+ repeat ( rem$ )
+ 2drop
+;
+
+: time-from-oats
+ load-crypto abort" Crypto load failed"
+ open-http
+ oats-msg$ ?save-string oats-send
+ " check-header" ['] $call-http catch if
+ ." Bad HTTP header" cr
+ close-http
+ abort
+ then
+ " image-size" $call-http ( len )
+
+ oats-buf over " wait-read" $call-http ( len actual )
+ close-http ( len actual )
+
+ 2dup <> if ( len actual )
+ ." Wrong HTTP content length - Expected " swap .d ." got " .d cr
+ abort
+ then ( len actual )
+
+ nip oats-buf swap decode-oats-response ( adr len )
+ verify-oats
+
+ time-data count parse-time " set-time" clock-node @ $call-method
+
+ cr ." Set clock to " .clock
+;
+time-from-oats
More information about the openfirmware
mailing list