From a0752ae96f80f3bbd737f261f0aa9311e9fd846f Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 21 Feb 2017 21:11:23 -0800 Subject: [PATCH] Eliminate ancient krypt program. --- src/runtime/ed-ffi.scm | 2 - src/runtime/krypt.scm | 255 --------------------------------------- src/runtime/kryptdum.scm | 38 ------ src/runtime/optiondb.scm | 1 - src/runtime/runtime.pkg | 9 -- 5 files changed, 305 deletions(-) delete mode 100644 src/runtime/krypt.scm delete mode 100644 src/runtime/kryptdum.scm diff --git a/src/runtime/ed-ffi.scm b/src/runtime/ed-ffi.scm index 747cac3d3..08dac98ec 100644 --- a/src/runtime/ed-ffi.scm +++ b/src/runtime/ed-ffi.scm @@ -101,8 +101,6 @@ USA. ("intrpt" (runtime interrupt-handler)) ("io" (runtime primitive-io)) ("keyword" (runtime keyword)) - ("krypt" (runtime krypt)) - ("kryptdum" (runtime krypt)) ("lambda" (runtime lambda-abstraction)) ("lambda-list" (runtime lambda-list)) ("lambdx" (runtime alternative-lambda)) diff --git a/src/runtime/krypt.scm b/src/runtime/krypt.scm deleted file mode 100644 index 0db2aaa72..000000000 --- a/src/runtime/krypt.scm +++ /dev/null @@ -1,255 +0,0 @@ -#| -*-Scheme-*- - -Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, - 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, - 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, - 2017 Massachusetts Institute of Technology - -This file is part of MIT/GNU Scheme. - -MIT/GNU Scheme is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or (at -your option) any later version. - -MIT/GNU Scheme is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -You should have received a copy of the GNU General Public License -along with MIT/GNU Scheme; if not, write to the Free Software -Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, -USA. - -|# - -;;;; Encryption/Decryption functions -;;; package: (runtime krypt) - -(declare (usual-integrations)) - -;;; This implementation is based on krypt.c, written by Ron Rivest. -;;; encrypt and decrypt are compatible with krypt.c. - -(define-integrable ts 256) ; Actual table size to use - -(define-structure (krypt-key (conc-name krypt-key/) - (constructor make-krypt-key ())) - (state-table (make-vector ts)) - (index-i #f) - (index-j #f)) - -(define (rcm-keyinit key) - (let loop ((i 0)) - (if (fix:< i ts) - (begin - (vector-set! (krypt-key/state-table key) i i) - (loop (fix:1+ i))) - (begin - (set-krypt-key/index-i! key 0) - (set-krypt-key/index-j! key 0))))) - -(define (rcm-key key kbuf) - (let ((m (string-length kbuf))) - (let loop ((i 0) - (j 0) - (k 0)) - (if (fix:< i ts) - (begin - (let ((s (krypt-key/state-table key))) - (let* ((j (fix:remainder (fix:+ (fix:+ j 1) - (fix:+ (vector-ref s i) - (vector-8b-ref kbuf k))) - ts)) - (t (vector-ref s i))) - (vector-set! s i (vector-ref s j)) - (vector-set! s j t) - (loop (fix:1+ i) j (fix:remainder (fix:1+ k) m))))))))) - -(define-integrable (inc-mod i ts) - (fix:remainder i ts)) - -(define-integrable (rcm key n buf) - (rcm-iter key n buf 0)) - -(define (rcm-iter key n buf start-index) - (let ((i (krypt-key/index-i key)) - (j (krypt-key/index-j key)) - (s (krypt-key/state-table key)) - (end-index (fix:+ n start-index))) - (let loop ((k start-index) - (i i) - (j j)) - (if (fix:< k end-index) - (begin - (let* ((i (inc-mod (fix:1+ i) ts)) - (j (inc-mod (fix:+ j (vector-ref s i)) ts)) - (t (vector-ref s i))) - (vector-set! s i (vector-ref s j)) - (vector-set! s j t) - (vector-8b-set! - buf k - (fix:xor (vector-8b-ref buf k) - (vector-ref s (inc-mod - (fix:+ (fix:1+ (vector-ref s i)) - (vector-ref s j)) - ts)))) - (loop (fix:1+ k) i j))) - (begin - (set-krypt-key/index-i! key i) - (set-krypt-key/index-j! key j)))))) - -(define kryptid "This file krypted ") - -(define (get-krypt-time-string) - (let ((the-time (local-decoded-time))) - (string-append - (vector-ref '#("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun") - (decoded-time/day-of-week the-time)) - " " - (vector-ref '#("Jan" "Feb" "Mar" "Apr" "May" "Jun" - "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") - (-1+ (decoded-time/month the-time))) - " " - (string-pad-left (write-to-string (decoded-time/day the-time)) 2) - " " - (string-pad-left (write-to-string (decoded-time/hour the-time)) 2) - ":" - (string-pad-left (write-to-string (decoded-time/minute the-time)) 2 #\0) - ":" - (string-pad-left (write-to-string (decoded-time/second the-time)) 2 #\0) - " " - (write-to-string (decoded-time/year the-time))))) - -(define (update-checksum cs block index length) - (let ((end-index (fix:+ index length))) - (let loop ((i index) - (checksum cs)) - (if (fix:< i end-index) - (loop (fix:1+ i) (fix:+ checksum (vector-8b-ref block i))) - (fix:remainder checksum 256))))) - -(define encrypt) -(define decrypt) - -(let ((unlocked? 'UNKNOWN) - (key-sum "84c3aad7f848b9a5a02e65b7834a696c")) - - (define (check-key) - (initialize-key) - (if (not unlocked?) - (error "Krypt support disabled in this implementation."))) - - (define (initialize-key) - (if (eq? 'UNKNOWN unlocked?) - (set! unlocked? - (and (md5-available?) - (let ((pathname - (call-with-current-continuation - (lambda (k) - (bind-condition-handler - (list condition-type:file-error) - (lambda (condition) - condition - (k #f)) - (lambda () - (system-library-pathname "krypt.key"))))))) - (and pathname - (string=? key-sum - (mhash-sum->hexadecimal - (md5-file pathname))))))))) - - (set! encrypt - (lambda (input-string password) - (check-key) - (let* ((checksum 0) - (header (string-append kryptid (get-krypt-time-string) "\n")) - (hlen (string-length header)) - (output-string - (make-legacy-string - (fix:+ 6 (fix:+ hlen (string-length input-string))))) - (end-index (fix:- (string-length output-string) ts))) - (let ((key1 (make-krypt-key))) - (rcm-keyinit key1) - (rcm-key key1 header) - (rcm-key key1 password) - (let ((passwordmac (make-legacy-string 5 #\NUL))) - (rcm key1 5 passwordmac) - (substring-move! header 0 hlen output-string 0) - (substring-move! passwordmac 0 5 output-string hlen) - (substring-move! input-string 0 - (string-length input-string) - output-string (fix:+ hlen 5))) - (let loop ((index (fix:+ hlen 5))) - (if (fix:< index end-index) - (begin - (set! checksum - (update-checksum checksum output-string index ts)) - (rcm-iter key1 ts output-string index) - (loop (fix:+ index ts))) - (let ((count - (fix:- (string-length output-string) - (fix:1+ index)))) - (set! checksum - (update-checksum checksum output-string index - count)) - (rcm-iter key1 count output-string index)))) - (let ((check-char (integer->char (modulo (- checksum) ts)))) - (let ((cc-string (char->string check-char))) - (rcm key1 1 cc-string) - (string-set! output-string - (fix:-1+ (string-length output-string)) - (string-ref cc-string 0)))) - output-string)))) - - (set! decrypt - (lambda (input-string password - #!optional password-error checksum-error) - (check-key) - (let* ((header-length (+ (string-length kryptid) 25)) - (header (string-head input-string header-length)) - (pwordmac - (substring input-string header-length - (fix:+ header-length 5))) - (output-string - (string-tail input-string (fix:+ header-length 5))) - (end-index (fix:- (string-length output-string) ts)) - (key1 (make-krypt-key)) - (checksum 0)) - (rcm-keyinit key1) - (rcm-key key1 header) - (rcm-key key1 password) - (let ((passwordmac (make-legacy-string 5 #\NUL))) - (rcm key1 5 passwordmac) - (if (string=? passwordmac pwordmac) - (begin - (let loop ((index 0)) - (if (fix:< index end-index) - (begin - (rcm-iter key1 ts output-string index) - (set! checksum - (update-checksum checksum output-string - index ts)) - (loop (fix:+ index ts))) - (let ((count - (fix:- (string-length output-string) - index))) - (rcm-iter key1 count output-string index) - (set! checksum - (update-checksum checksum output-string - index count))))) - (if (not (= (modulo checksum 256) 0)) - (if (default-object? checksum-error) - (error "krypt: Checksum error.") - (checksum-error output-string)) - (begin - (set-string-length! - output-string - (fix:-1+ (string-length output-string))) - output-string))) - (if (default-object? password-error) - (error "krypt: Password error.") - (password-error))))))) - - ) \ No newline at end of file diff --git a/src/runtime/kryptdum.scm b/src/runtime/kryptdum.scm deleted file mode 100644 index 57f7495c0..000000000 --- a/src/runtime/kryptdum.scm +++ /dev/null @@ -1,38 +0,0 @@ -#| -*-Scheme-*- - -Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, - 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, - 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, - 2017 Massachusetts Institute of Technology - -This file is part of MIT/GNU Scheme. - -MIT/GNU Scheme is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or (at -your option) any later version. - -MIT/GNU Scheme is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -You should have received a copy of the GNU General Public License -along with MIT/GNU Scheme; if not, write to the Free Software -Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, -USA. - -|# - -;;;; Encryption/Decryption dummy stubs -;;; package: (runtime krypt) - -(declare (usual-integrations)) - -(define (encrypt string password) - password - string) - -(define (decrypt string password #!optional password-error checksum-error) - password password-error checksum-error - string) \ No newline at end of file diff --git a/src/runtime/optiondb.scm b/src/runtime/optiondb.scm index 2788df648..84b93321b 100644 --- a/src/runtime/optiondb.scm +++ b/src/runtime/optiondb.scm @@ -67,7 +67,6 @@ USA. (DOSPROCESS () #F "dosproc") (FORMAT (RUNTIME FORMAT) (INITIALIZE-PACKAGE!) "format") (GDBM (RUNTIME GDBM) #F "gdbm") - (KRYPT (RUNTIME KRYPT) #F "krypt") (MIME-CODEC (RUNTIME MIME-CODEC) #F "mime-codec") (ORDERED-VECTOR (RUNTIME ORDERED-VECTOR) #F "ordvec") (POSTGRESQL (RUNTIME POSTGRESQL) #F "pgsql") diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 6efb73733..cb8c2a9e1 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -2657,15 +2657,6 @@ USA. history-untransform) (initialization (initialize-package!))) -(define-package (runtime krypt) - (file-case options - ((load) "krypt") - (else)) - (parent (runtime)) - (export () - encrypt - decrypt)) - (define-package (runtime compress) (file-case options ((load) "cpress") -- 2.25.1