obol-scripts/selftest.obol
; Obol selftest
; $Id: selftest.obol,v 1.1 2007/03/16 16:30:25 perm Exp $
;
(script "selftest"
:doc "generic selftest script."
[debuglevel INFO]
[debuglevel "parser.ObolParser" WARN]
[print]
[print "Checking string escapes (\\b\\t\\n\\r\\\"\\\\\\0377\\xff\\u0003\\0)"]
(believe *esc_str "\b\t\n\r\"\\\0377\xff\u0003\0" ((type binary)))
(believe *esc_str_chk "0x08090A0D225CFFFF0300" ((type binary)))
[assert *esc_str == *esc_str_chk]
[print "Setting format"]
;[format serialization]
[format spki]
[print]
[print "Testing assertions"]
[assert 1 == 1]
[assert 0 != 1]
[assert 0 < 1]
[assert 0 <= 1]
[assert 1 > 0]
[assert 1 >= 0]
[assert "aaa" < "bbb"]
[assert "caa" > "bbb"]
;;
;; Testing (believe) type transitions
;;
[print "Testing believe"]
(believe a 123)
(believe b 123)
(believe a ((type string)))
(believe a ((type binary)))
(believe a ((type number)))
(believe a ((type binary)))
(believe a ((type string)))
(believe a ((type number)))
[assert a == b]
; The next line test namespace separation
(believe believe "believe")
[assert believe == "believe"]
;; properties w/keywords
(believe a (:foo (:quux)(bar baz)))
;; The next statement, when commented in, should cause a parse error.
;(believe a (" illegal-whitespace-property-name"))
;;
;; Testing (generate)
;;
[print]
[print "Testing generate"]
(generate *TS1 timestamp)
[print "Generating nonce"]
(generate Na nonce 128)
[print "Generating shared-key"]
(generate Ka shared-key AES 128)
[print "Generating RSA keypair"]
(generate Kp_a keypair RSA 1024)
[print "Believing public and private key from keypair"]
(believe K_a (public-key Kp_a))
(believe K_a-1 (private-key Kp_a))
[print "Examining public and private RSA exponent (key-part)"]
(believe pub_e (key-part (public-key Kp_a) "PublicExponent"))
(believe priv_e (key-part K_a-1 "PrivateExponent"))
[assert pub_e != priv_e]
[print "Testing MD5"]
(believe *mdsrc "a")
;; this should be 0x0cc175b9c0f1b6a831c399e269772661
(generate *h1 hash MD5 *mdsrc)
;; this should also be 0x0cc175b9c0f1b6a831c399e269772661
(generate *h2 hash MD5 "a")
[print *h1 *h2]
[assert *h1 == *h2]
[print "Testing timestamp"]
(generate *TS2 timestamp)
[assert *TS1 < *TS2]
[print "Testing nonce to shared-key conversions"]
(believe *ka *h1 ((type shared-key)(alg AES)))
(believe **ka Na ((type shared-key)(alg AES)))
;;
;; Testing anonymous send/receive
;;
[print]
[print "Testing anonymous send"]
(send *anonMsg "foo" 123 Ka *h1)
[print "Testing anonymous receive"]
(receive *anonMsg "foo" *r1 *r2 *r3)
[assert b == *r1]
[assert Ka == *r2]
[assert *h1 == *r3]
;;
;; Testing (encrypt)/(decrypt)
;;
[print]
[print "Testing shared-key encryption/decryption"]
(believe plaintext "This is a test plaintext!")
(believe *ciphertext (encrypt Ka plaintext))
(decrypt (Ka *ciphertext) *decrypted)
[assert plaintext == *decrypted]
[print "Testing shared-key encryption/decryption, using forced anonymous
variables and expected plaintext in the decrypt statement"]
(believe **ciphertext (encrypt Ka *decrypted))
(decrypt (Ka *ciphertext) plaintext)
[print]
[print "Testing multi-forced variable bogosity detection:"]
[print "...there should be two warnings printed below:"]
(believe **c (encrypt Ka 123 123 123))
(decrypt (Ka *c) **0 **0 **0)
[print "...there should NOT be warnings below this text:"]
(decrypt (Ka *c) **0 *0 *0)
[print "Done testing multi-forced variable bogosity detection: there should be 2 warnings above, no more, no less!"]
[print]
[print "Testing MessageDigest ``signature'' literal MD5"]
(believe *md (sign "MD5" "a"))
(verify ("MD5" *md) "a")
[print "Testing MessageDigest ``signature'' symbol SHA1"]
(believe *md-name "SHA1")
(believe **md (sign *md-name "a"))
(verify (*md-name *md) "a")
[print "Testing MessageDigest ``signature'' symbol SHA-512"]
(believe **md-name "SHA-512")
(believe **md (sign *md-name "a"))
(verify (*md-name *md) "a")
[print]
[print "Testing MACs (default)"]
(believe *mac (sign Ka plaintext))
(verify (Ka *mac) plaintext)
[print "Testing MACs (HmacSHA512)"]
(believe Ka ((MAC-type HmacSHA512)))
(believe **mac (sign Ka plaintext "foo"))
(verify (Ka *mac) plaintext "foo")
[print "Testing public-key encryption/decryption"]
(believe **ciphertext (encrypt K_a Na))
(decrypt (K_a-1 *ciphertext) *Na)
[assert Na == *Na]
(decrypt (K_a-1 *ciphertext) Na)
;;
;; Testing (sign)/(verify)
;;
[print]
[print "Testing signature operations"]
(believe *signvalue (sign K_a-1 plaintext))
(verify (K_a *signvalue) plaintext)
[print "Testing encapsulated (encrypted) signature operations"]
(believe **ciphertext (encrypt Ka plaintext (sign K_a-1 plaintext) "foo"))
(decrypt (Ka *ciphertext) plaintext (verify K_a plaintext) *text)
[print "Attempting left-to right assign, then match of anonymous variable"]
(decrypt (Ka *ciphertext) *foo (verify K_a *foo) *text)
;;
;; Testing complex expressions
;;
[print]
[print "Testing complex expressions"]
(generate *K shared-key DES 56)
(believe **ciphertext (encrypt Ka (encrypt *K plaintext (sign K_a-1 *K) Na)))
(decrypt (Ka *ciphertext) (decrypt *K plaintext *sigval *na))
[assert Na == *na]
(believe **ciphertext
(encrypt Ka Ka plaintext Na (sign K_a-1 Na plaintext Ka) Ka "foo"))
(decrypt (Ka *ciphertext)
*key plaintext *n (verify K_a *n plaintext Ka) *key "foo")
[print "Testing encrypted signature on encrypted and signed data"]
;; This won't work, because encrypt result is not cached.
;(generate **K shared-key AES 128)
;(believe **c (encrypt Ka "foo"))
;(believe **s (sign K_a-1 *c))
;(verify (K_a *s) *c)
;(believe **ciphertext (encrypt *K Na (encrypt Ka (sign K_a-1 "foo" (encrypt *K Na)))))
;(decrypt (*K *ciphertext) Na (decrypt Ka (verify K_a "foo" (encrypt *K Na))))
;; This will print warnings, because we're sending a secret key over some
;; channel (it's encrypted, so it's ok).
[print "(warnings about secret key is ok)"]
(generate K shared-key AES 128)
(believe **c (encrypt K Na))
(believe **ciphertext (encrypt K Na (encrypt Ka *c (sign K_a-1 "foo" *c))))
(decrypt (K *ciphertext) **Na (decrypt Ka **c (verify K_a "foo" *c)))
(decrypt (K *c) *Na)
(decrypt (K *c) **Na)
[print]
[print "Testing format's conversion of public keys to binary and back"]
[print "(Uses DSA keys, so if the Format is strict, it might bomb...)"]
;; Generate a keypair, encrypt the private key, then decrypt it, believe the
;; binary blob is a public-key, then try to verify a signature with it.
(generate kp keypair DSA 1024)
(generate k shared-key aes 128)
[print k]
(believe pub (public-key kp))
(believe priv (private-key kp))
(believe **sigval (sign priv "foo"))
(verify (pub *sigval) "foo")
(believe **c (encrypt k "foo" pub))
(decrypt (k *c) "foo" *1)
(believe *1 ((type public-key)(alg DSA)))
(verify (*1 *sigval) "foo")
[assert *1 == pub] ;; example of value-equality assertion
[print]
[print "Testing pre-belief"]
(believe **n k nonce)
(send **c *n (encrypt k plaintext))
(believe *k1 ((type shared-key)(alg aes)))
[print "*k1 = " *k1]
(receive *c *k1 (decrypt *k1 plaintext))
[print]
[print "Testing (cond)"]
(believe **ciphertext (encrypt Ka plaintext))
(believe **md-name "SHA-512")
(believe **md (sign *md-name "a"))
(believe **mac (sign Ka plaintext))
(cond
((== 1 1) ())
((== 1 1) ((generate **n nonce 128)))
((== 1 1) ([print " (== 1 1) test works"]
(believe **n 123)
(generate **n nonce 128)))
((not (== 1 0))([print " not works"]))
((!= 1 0) ([print " (!= 1 0) test works"]))
((== 1 0) ([print " (== 0 1) never executes, but parses!"]))
((< *TS1 *TS2) ([print " *TS1 < *TS2"]))
((== *TS1 *TS2) ([print " *TS1 == *TS2:" *TS1 *TS2]))
((> *TS1 *TS2) ([print " *TS1 > *TS2"]))
((== 1 0) ([print " (== 1 0) does NOT work"]))
((== 1 1) (
(cond ((== 1 1)([print " nested (cond) works"])))))
((null *neverbeforeusedanonymousvariable) ([print " null works"]))
((null (get *md "bogusproperty")) ([print " negative symbol-property existance test in cond-test works"]))
((not (null (get *md "type"))) ([print " positive symbol-property existance test in cond-test works"]))
((== (get *md "type") "binary") ([print " symbol-property comparison in cond-test works"]))
((not (null *mac)) ([print " not null works"]))
((receive *c *k1 (decrypt *k1 plaintext)) ([print " receive in cond works!"]))
((receive *c *k1 (decrypt *k1 "junk")) ([print " receive in cond works NOT (ignores bogus decryption)!"]))
((not (receive *c *k1 (decrypt *k1 "foo"))) ([print " negated receive in cond works!"]))
((decrypt (Ka *ciphertext) plaintext) ([print " decrypt in cond works!"]))
((not (decrypt (Ka *ciphertext) plaintext)) ([print " decrypt in cond DOES NOT works!"]))
((not (decrypt (Ka *ciphertext) *ciphertext)) ([print " negated decrypt (failed decryption) in cond works!"]))
((not (decrypt (Ka *c) plaintext)) ([print " ^^^-decryption of messages as ciphertext symbols should fail (any exception printout directly above this line is not an error)!"]))
((verify (*md-name *md) "a") ([print " digest-type signature verified in cond!"]))
((not (verify (*md-name *md) "b")) ([print " incorrect digest-type signature NOT verified in cond!"]))
((verify (Ka *mac) plaintext) ([print " HMAC signature verified in cond!"]))
((not (verify (Ka *mac) "a")) ([print " incorrect HMAC signature NOT verified in cond!"]))
((verify (K_a *signvalue) plaintext) ([print " digital signature verified in cond!"]))
((not (verify (K_a *signvalue) "a")) ([print " incorrect digital signature NOT verified in cond!"]))
)
[print]
[print "Testing (if) with random input"]
(generate *coin nonce 1)
(believe *coin ((type number)))
(if (== 0 *coin)
([print "picked zero, flipping..."](believe **coin 1))
else ([print "picked one, flipping..."](believe **coin 0)))
(if (== 0 *coin)
([print "flipped coin is now zero (should be one above)"])
else ([print "flipped coin is now zero (should be zero above)"]))
[print]
[print "Testing (loop) with (endloop) and loop-reset-symbol"]
(believe **n 0)
(loop
(believe *reset-me *n)
(cond
((== 1 1) ((cond ((== 1 1)([print " nested cond, in loop"])))))
((== 0 *n) ([print " changing value"](believe **n 1)))
((== 1 *n) ([print " changing value"](believe **n 2)))
((>= 2 *n) ([print " calling endloop"](endloop))))
(loop-reset-symbol **reset-me))
[print "Current value = " *n]
[print]
[print "Testing (loop (dotimes ...) ...)"]
(believe **n 5)
(loop (dotimes *n)
[print " Iteration..."])
[print " Now with step-count variable, and loop-reset-symbol..."]
(loop (dotimes **i *n)
(loop-reset-symbol **reset-me)
[print " Iteration..."])
[print "Current value = " *i]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
[print]
[print "SUCCESS!"]
)
;; To test unordered match-mode, we must use a client and server. The
;; following should work:
;; server: echo '[self "localhost:9001" "spki" ((match-ordering unordered))](believe *1 ((type shared-key)(alg aes)))(receive *a *1 (decrypt *1 "foo" *2))[print][print "should not be foo:" *2]' | java testParse
;; client: echo '[format spki](believe a "localhost:9001" host)(generate k shared-key aes 128)(send a k (encrypt k "bar" "foo"))' | java testParser
Generated by GNU enscript 1.6.4.