From: Matt Birkholz Date: Tue, 8 Mar 2016 18:41:50 +0000 (-0700) Subject: Punt plugin -available? procedures. X-Git-Tag: mit-scheme-pucked-9.2.12~261^2~75^2~11 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=cc18d4098ccb65da945a1168110ed67cf5034da7;p=mit-scheme.git Punt plugin -available? procedures. Such procedures made sense in (runtime crypto), but make little sense in a plugin where they are defined only after the plugin is installed and loaded. --- diff --git a/src/blowfish/blowfish-check.scm b/src/blowfish/blowfish-check.scm index 2f89d742f..6aacdfce9 100644 --- a/src/blowfish/blowfish-check.scm +++ b/src/blowfish/blowfish-check.scm @@ -26,23 +26,21 @@ USA. ;;;; Test the BLOWFISH option. -(if (not (blowfish-available?)) - (error "BLOWFISH plugin not found") - (let ((sample "Some text to encrypt and decrypt.")) - (call-with-binary-output-file "test" - (lambda (output) - (call-with-input-string sample - (lambda (input) - (blowfish-encrypt-port input output "secret" - (write-blowfish-file-header output) - #t))))) - (let ((read-back - (call-with-binary-input-file "test" - (lambda (input) - (call-with-output-string - (lambda (output) - (blowfish-encrypt-port input output "secret" - (read-blowfish-file-header input) - #f))))))) - (if (not (string=? sample read-back)) - (error "sample did not decrypt correctly"))))) \ No newline at end of file +(let ((sample "Some text to encrypt and decrypt.")) + (call-with-binary-output-file "test" + (lambda (output) + (call-with-input-string sample + (lambda (input) + (blowfish-encrypt-port input output "secret" + (write-blowfish-file-header output) + #t))))) + (let ((read-back + (call-with-binary-input-file "test" + (lambda (input) + (call-with-output-string + (lambda (output) + (blowfish-encrypt-port input output "secret" + (read-blowfish-file-header input) + #f))))))) + (if (not (string=? sample read-back)) + (error "sample did not decrypt correctly")))) \ No newline at end of file diff --git a/src/blowfish/blowfish.pkg b/src/blowfish/blowfish.pkg index 34685216b..e31f55421 100644 --- a/src/blowfish/blowfish.pkg +++ b/src/blowfish/blowfish.pkg @@ -32,7 +32,6 @@ USA. ;; You'll have to import these from (global-definitions blowfish/). ;; They are currently bound in () by exports from (runtime blowfish). (export (blowfish global) - blowfish-available? blowfish-cbc blowfish-cfb64 blowfish-ecb diff --git a/src/blowfish/blowfish.scm b/src/blowfish/blowfish.scm index 9107cc400..8be160da4 100644 --- a/src/blowfish/blowfish.scm +++ b/src/blowfish/blowfish.scm @@ -171,9 +171,6 @@ USA. "a blowfish init-vector index" operator))) -(define (blowfish-available?) - (plugin-available? "blowfish")) - (define (blowfish-encrypt-port input output key init-vector encrypt?) ;; Assumes that INPUT is in blocking mode. (let ((key (blowfish-set-key key)) diff --git a/src/gdbm/gdbm-check.scm b/src/gdbm/gdbm-check.scm index e35559b88..c3e0ea9f8 100644 --- a/src/gdbm/gdbm-check.scm +++ b/src/gdbm/gdbm-check.scm @@ -26,74 +26,72 @@ USA. ;;;; Test the GDBM option. -(if (not (gdbm-available?)) - (error "GDBM plugin not found") - (let ((filename.db "gdbm-check.db")) - (ignore-errors (lambda () (delete-file filename.db))) - (let ((dbf (gdbm-open filename.db 0 GDBM_WRCREAT #o660))) - ;; Must be set before first store. - (gdbm-setopt dbf GDBM_CACHESIZE 101) - - (gdbm-store dbf "Silly String" "Testing 1 2 3." GDBM_REPLACE) - (if (not (condition? - (ignore-errors - (lambda () (gdbm-store dbf "NullString" "" GDBM_INSERT))))) - (error "storing null content did not signal")) - (if (not (condition? - (ignore-errors - (lambda () (gdbm-store dbf "" "NullString" GDBM_INSERT))))) - (error "storing null key did not signal")) - (if (not (eq? #t (gdbm-store dbf "Silly String" "Ahoy!" GDBM_REPLACE))) - (error "replace produced wrong indication")) - (if (not (eq? #f (gdbm-store dbf "Silly String" "Oy!" GDBM_INSERT))) - (error "double insert produced no indication")) - - (gdbm-setopt dbf GDBM_SYNCMODE 1) - - (let ((content (gdbm-fetch dbf "Silly String"))) - (if (not (string=? "Ahoy!" content)) - (error "fetched:" content))) - (let ((content (gdbm-fetch dbf "Missing String"))) - (if (not (eq? #f content)) - (error "missing fetched:" content))) - - (if (gdbm-exists? dbf "Missing String") - (error "exists")) - (if (not (gdbm-exists? dbf "Silly String")) - (error "not exists")) - - (gdbm-delete dbf "Silly String") - (if (gdbm-exists? dbf "Silly String") - (error "not deleted")) - (if (gdbm-delete dbf "Missing String") - (error "deleted")) - - (let ((k (gdbm-firstkey dbf))) - (if k - (error "empty database returned a firstkey:" k))) - (gdbm-store dbf "AString" "Testing 1 2 3." GDBM_INSERT) - (gdbm-store dbf "ASecondString" "Testing 1 2 3." GDBM_REPLACE) - (gdbm-store dbf "AThirdString" "Testing 1 2 3." GDBM_INSERT) - #;(let ((keys (sort (gdbm-keys dbf) stringchar (random 256)))))) -(if (not (mcrypt-available?)) - (error "MCRYPT plugin not found") - (begin - (if (not (member "tripledes" (mcrypt-algorithm-names))) - (error "No tripledes.")) +(if (not (member "tripledes" (mcrypt-algorithm-names))) + (error "No tripledes.")) - (if (not (member "cfb" (mcrypt-mode-names))) - (error "No cipher-feedback mode.")) +(if (not (member "cfb" (mcrypt-mode-names))) + (error "No cipher-feedback mode.")) - (let ((key (let ((sizes (mcrypt-supported-key-sizes "tripledes"))) - (if (not (vector? sizes)) - (error "Bogus key sizes for tripledes.")) - (random-string (vector-ref sizes - (-1+ (vector-length sizes)))))) - (init-vector (let* ((context - ;; Unfortunately the size is - ;; available only from the MCRYPT(?)! - (mcrypt-open-module "tripledes" "cfb")) - (size (mcrypt-init-vector-size context))) - (mcrypt-end context) - (random-string size)))) +(let ((key (let ((sizes (mcrypt-supported-key-sizes "tripledes"))) + (if (not (vector? sizes)) + (error "Bogus key sizes for tripledes.")) + (random-string (vector-ref sizes + (-1+ (vector-length sizes)))))) + (init-vector (let* ((context + ;; Unfortunately the size is + ;; available only from the MCRYPT(?)! + (mcrypt-open-module "tripledes" "cfb")) + (size (mcrypt-init-vector-size context))) + (mcrypt-end context) + (random-string size)))) - (call-with-input-file "mcrypt.scm" - (lambda (input) - (call-with-output-file "encrypted" - (lambda (output) - (let ((copy (string-copy init-vector))) - (mcrypt-encrypt-port "tripledes" "cfb" - input output key init-vector #t) - (if (not (string=? copy init-vector)) - (error "Init vector modified."))))))) + (call-with-input-file "mcrypt.scm" + (lambda (input) + (call-with-output-file "encrypted" + (lambda (output) + (let ((copy (string-copy init-vector))) + (mcrypt-encrypt-port "tripledes" "cfb" + input output key init-vector #t) + (if (not (string=? copy init-vector)) + (error "Init vector modified."))))))) - (call-with-input-file "encrypted" - (lambda (input) - (call-with-output-file "decrypted" - (lambda (output) - (mcrypt-encrypt-port "tripledes" "cfb" - input output key init-vector #f)))))) + (call-with-input-file "encrypted" + (lambda (input) + (call-with-output-file "decrypted" + (lambda (output) + (mcrypt-encrypt-port "tripledes" "cfb" + input output key init-vector #f)))))) - (if (not (= 0 (run-shell-command "cmp mcrypt.scm decrypted"))) - (error "En/Decryption failed.")))) \ No newline at end of file +(if (not (= 0 (run-shell-command "cmp mcrypt.scm decrypted"))) + (error "En/Decryption failed.")) \ No newline at end of file diff --git a/src/mcrypt/mcrypt.pkg b/src/mcrypt/mcrypt.pkg index 5bff03316..f536f003c 100644 --- a/src/mcrypt/mcrypt.pkg +++ b/src/mcrypt/mcrypt.pkg @@ -36,7 +36,6 @@ USA. (export (mcrypt global) mcrypt-algorithm-name mcrypt-algorithm-names - mcrypt-available? mcrypt-block-algorithm-mode? mcrypt-block-algorithm? mcrypt-block-mode? diff --git a/src/mcrypt/mcrypt.scm b/src/mcrypt/mcrypt.scm index 841dbcb16..357696fe8 100644 --- a/src/mcrypt/mcrypt.scm +++ b/src/mcrypt/mcrypt.scm @@ -91,9 +91,6 @@ USA. (define mcrypt-algorithm-names-vector) (define mcrypt-mode-names-vector) -(define (mcrypt-available?) - (plugin-available? "mcrypt")) - (define (init!) (if (not mcrypt-initialized?) (begin diff --git a/src/md5/md5-check.scm b/src/md5/md5-check.scm index fb86f209b..dde27fca1 100644 --- a/src/md5/md5-check.scm +++ b/src/md5/md5-check.scm @@ -26,14 +26,12 @@ USA. ;;;; Test the MD5 option. -(if (not (md5-available?)) - (error "MD5 plugin not found") - (let ((sample "Some text to hash.")) - (let ((hash (md5-sum->hexadecimal (md5-string sample)))) - (if (not (string=? hash "c8e89c4cbf3abf9aa758d691cbe4b784")) - (error "Bad hash for sample text:" hash))) - (call-with-output-file "sample" - (lambda (port) (write-string sample port) (newline port))) - (let ((hash (md5-sum->hexadecimal (md5-file "sample")))) - (if (not (string=? hash "43eb9eccb88c329721925efc04843af1")) - (error "Bad hash for sample file:" hash))))) \ No newline at end of file +(let ((sample "Some text to hash.")) + (let ((hash (md5-sum->hexadecimal (md5-string sample)))) + (if (not (string=? hash "c8e89c4cbf3abf9aa758d691cbe4b784")) + (error "Bad hash for sample text:" hash))) + (call-with-output-file "sample" + (lambda (port) (write-string sample port) (newline port))) + (let ((hash (md5-sum->hexadecimal (md5-file "sample")))) + (if (not (string=? hash "43eb9eccb88c329721925efc04843af1")) + (error "Bad hash for sample file:" hash)))) \ No newline at end of file diff --git a/src/md5/md5.pkg b/src/md5/md5.pkg index a6229937c..a9a5e4e2d 100644 --- a/src/md5/md5.pkg +++ b/src/md5/md5.pkg @@ -32,7 +32,6 @@ USA. ;; You'll have to import these from (global-definitions md5/). They ;; are currently bound in () by exports from (runtime crypto). (export (md5 global) - md5-available? md5-file md5-string md5-substring diff --git a/src/md5/md5.scm b/src/md5/md5.scm index a8052fa66..70408537f 100644 --- a/src/md5/md5.scm +++ b/src/md5/md5.scm @@ -31,9 +31,6 @@ USA. (C-include "md5") -(define (mhash-available?) - (plugin-available? "mhash")) - (define (%md5-init) ;; Create and return an MD5 digest context. (let ((context (make-string (C-sizeof "MD5_CTX")))) @@ -70,22 +67,7 @@ USA. (C-call "do_MD5" string length result) result)) -(define (md5-available?) - (or (mhash-available?) - (%md5-available?))) - -(define (%md5-available?) - (plugin-available? "md5")) - (define (md5-file filename) - (cond ((mhash-available?) - (mhash-file 'MD5 filename)) - ((%md5-available?) - (%md5-file filename)) - (else - (error "This Scheme system was built without MD5 support.")))) - -(define (%md5-file filename) (call-with-binary-input-file filename (lambda (port) (let ((buffer (make-string 4096)) @@ -107,14 +89,6 @@ USA. (md5-substring string 0 (string-length string))) (define (md5-substring string start end) - (cond ((mhash-available?) - (mhash-substring 'MD5 string start end)) - ((%md5-available?) - (%md5-substring string start end)) - (else - (error "This Scheme system was built without MD5 support.")))) - -(define (%md5-substring string start end) (let ((context (%md5-init))) (%md5-update context string start end) (%md5-final context))) diff --git a/src/mhash/mhash-check.scm b/src/mhash/mhash-check.scm index 7c58c7928..ff527f98f 100644 --- a/src/mhash/mhash-check.scm +++ b/src/mhash/mhash-check.scm @@ -26,14 +26,12 @@ USA. ;;;; Test the MHASH option. -(if (not (mhash-available?)) - (error "MHASH plugin not found") - (let ((sample "Some text to hash.")) - (let ((hash (mhash-sum->hexadecimal (mhash-string 'MD5 sample)))) - (if (not (string=? hash "c8e89c4cbf3abf9aa758d691cbe4b784")) - (error "Bad hash for sample text:" hash))) - (call-with-output-file "sample" - (lambda (port) (write-string sample port) (newline port))) - (let ((hash (mhash-sum->hexadecimal (mhash-file 'MD5 "sample")))) - (if (not (string=? hash "43eb9eccb88c329721925efc04843af1")) - (error "Bad hash for sample file:" hash))))) \ No newline at end of file +(let ((sample "Some text to hash.")) + (let ((hash (mhash-sum->hexadecimal (mhash-string 'MD5 sample)))) + (if (not (string=? hash "c8e89c4cbf3abf9aa758d691cbe4b784")) + (error "Bad hash for sample text:" hash))) + (call-with-output-file "sample" + (lambda (port) (write-string sample port) (newline port))) + (let ((hash (mhash-sum->hexadecimal (mhash-file 'MD5 "sample")))) + (if (not (string=? hash "43eb9eccb88c329721925efc04843af1")) + (error "Bad hash for sample file:" hash)))) \ No newline at end of file diff --git a/src/mhash/mhash.pkg b/src/mhash/mhash.pkg index b0223d92c..183f3162f 100644 --- a/src/mhash/mhash.pkg +++ b/src/mhash/mhash.pkg @@ -34,7 +34,6 @@ USA. ;; They are currently bound in () by exports from (runtime crypto). (export (mhash global) make-mhash-keygen-type - mhash-available? mhash-context? mhash-end mhash-file diff --git a/src/mhash/mhash.scm b/src/mhash/mhash.scm index 1cf152b6d..a7d43ac1a 100644 --- a/src/mhash/mhash.scm +++ b/src/mhash/mhash.scm @@ -31,7 +31,6 @@ USA. (C-include "mhash") -(define mhash-initialized? #f) (define mhash-algorithm-names) (define mhash-contexts '()) (define mhash-hmac-contexts '()) @@ -359,47 +358,38 @@ USA. (mhash-name->id (car names) 'MAKE-MHASH-KEYGEN-TYPE))) v))))) -(define (mhash-available?) - (and (plugin-available? "mhash") - (begin - (initialize-mhash-variables!) - #t))) - (define (initialize-mhash-variables!) - (if (not mhash-initialized?) - (begin - (set! mhash-algorithm-names - (make-names-vector - (lambda () (C-call "mhash_count")) - (lambda (hashid) - (let* ((alien (make-alien-to-free - '(* char) - (lambda (alien) - (C-call "mhash_get_hash_name" - alien hashid)))) - (str (c-peek-cstring alien))) - (free alien) - str)))) - (set! mhash-keygen-names - (make-names-vector - (lambda () (C-call "mhash_keygen_count")) - (lambda (keygenid) - (let* ((alien (make-alien-to-free - '(* char) - (lambda (alien) - (C-call "mhash_get_keygen_name" - alien keygenid)))) - (str (c-peek-cstring alien))) - (free alien) - str)))) - (set! mhash-initialized? #t)))) + (set! mhash-algorithm-names + (make-names-vector + (lambda () (C-call "mhash_count")) + (lambda (hashid) + (let* ((alien (make-alien-to-free + '(* char) + (lambda (alien) + (C-call "mhash_get_hash_name" + alien hashid)))) + (str (c-peek-cstring alien))) + (free alien) + str)))) + (set! mhash-keygen-names + (make-names-vector + (lambda () (C-call "mhash_keygen_count")) + (lambda (keygenid) + (let* ((alien (make-alien-to-free + '(* char) + (lambda (alien) + (C-call "mhash_get_keygen_name" + alien keygenid)))) + (str (c-peek-cstring alien))) + (free alien) + str))))) (define (reset-mhash-variables!) - (set! mhash-initialized? #f) (for-each (lambda (weak) (alien-null! (weak-cdr weak))) mhash-contexts) (set! mhash-contexts '()) (for-each (lambda (weak) (alien-null! (weak-cdr weak))) mhash-hmac-contexts) (set! mhash-hmac-contexts '()) + (initialize-mhash-variables!) unspecific) (define (mhash-file hash-type filename)