Eliminate ancient krypt program.

diff --git a/src/runtime/ed-ffi.scm b/src/runtime/ed-ffi.scm
index 747cac3d3e623355324540bc39eab44b09b81335..08dac98ece8f580d286cff23bf2ec454f89e13fd 100644 (file)
--- 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 (file)
index 0db2aaa..0000000
--- 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))
-\f
-;;; 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))))))
-\f
-(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)))))
-\f
-(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))))
-\f
-  (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 (file)
index 57f7495..0000000
--- 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 2788df6483d386b407528608c2dd27e1b3d68909..84b93321b4e2e2ffca069e3dac3b7462d07e91ee 100644 (file)
--- 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 6efb73733bf70b9537b1f2ce3aa0353492c64cc4..cb8c2a9e16bc71b25143ae5a95d29f79bb1d4d5d 100644 (file)
--- 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")