[ prog / sol / mona ]

prog


SchemeBBS [part 2]

8 2020-06-21 23:43

[1/2]
Here is an upgrade of >>4. When a file is too large to reasonably fit into mit-scheme's memory, and cannot be temporarily padded in place such as because it is located on read-only media, >>4 cannot handle it. The solution is to apply the padding at the port level, by creating a wrapper port that appends the padding on-the-fly once the wrapped port has been exhausted. Port documentation is at:
http://web.mit.edu/scheme_v9.2/doc/mit-scheme-ref/Port-Primitives.html

(define (port-padder iport suffix)
   (let* ((sflen (string-length suffix))
          (sent  #f)
          (iread (lambda (ip buf start end)
                    (let* ((want (- end start))
                           (got  (input-port/read-substring! iport buf start end))
                           (room (- want got)))
                       (cond ((= got want) got)
                              (sent (if (= got 0) 0 'error-zero))
                              ((> sflen room) 'error-fit)
                              (else (substring-move-left! suffix 0 sflen buf (+ start got))
                                    (set! sent #t)
                                    (+ got sflen))))))
          (ops   `((read-substring ,iread)))
          (itype (make-port-type ops (port/type iport))))
   (make-port itype (port/state iport))))

This is a wrapper specifically aimed at crypto.scm:mcrypt-encrypt-port rather than a general one. With file content being arbitrary only the PKCS#7 padding is kept.

; string to append
(define (padadd-pkcs7 slen unit)
   (let ((used (- unit (modulo slen unit))))
      (make-string used (ascii->char used))))

; length to delete
(define (paddel-pkcs7 stail unit)
   (let ((slen (string-length stail)))
      (char->ascii (string-ref stail (- slen 1)))))

Here is how to truncate a file in place to remove padding after decryption. This information can be extracted from io.scm and port.scm.

(define (portdo port opsym . rest)
   (apply (port/operation port opsym) port rest))

(define (truncate port length)
   (channel-file-truncate (portdo port 'output-channel) length))

(define (truncate-padding path paddel unit)
   (let* ((size (file-length path))
          (want 512)
          (take (min size want))
          (pos  (- size take))
          (tail (make-string take))
          (f    (open-binary-i/o-file path)))
      (portdo f 'set-position! pos)
      (input-port/read-string! f tail)
      (let* ((del (paddel tail unit))
             (pos (- size del)))
         (cond ((> del 0)
                   (portdo f 'set-position! pos)
                   (truncate f pos))))
      (close-port f)))

Here is the new engine. It can encrypt and decrypt from a file or string to a file or string. The input and output specifiers are as follows:
- The file specifier for both input and output, and for both encryption and decryption, is a list of two elements holding the symbol 'file followed by the filepath.
- The string input specifier for both encryption and decryption is a list of two elements holding the symbol 'string followed by the string.
- The string output specifier for encryption is a list of two elements holding the symbol 'string followed by an element that is ignored.
- The string output specifier for decryption is a list of two elements holding the symbol 'string followed by a boolean value that controls whether padding should be stripped off. The length of the unpadded output will be returned anyway, so when the result can be used with the padding included, such as via write-substring, this can avoid making a copy of essentially the entire output string.
The return value is as follows:
- For file output the output specifier is returned.
- For string output a list of three elements is returned holding the symbol 'string, followed by the output string and a length.
- For string output encryption the output string is the cyphertext and the length is the cyphertext length.
- For string output decryption the output string is the plaintext with padding stripped off if the boolean value in the second position of the output specifier was true and present otherwise. In either case the length is the unpadded plaintext length.

112


VIP:

do not edit these