lf2-survival-stage-generator/decrypt.scm

(library (decrypt)
  (export decrypt-u8 decrypt-file)
  (import
    (except (rnrs base) let-values)
    (only (guile)
          lambda* λ
          error
          eof-object?
          simple-format
          current-output-port
          current-input-port
          call-with-output-string
          remainder)
    (prefix (logging) log:)
    (ice-9 binary-ports)
    (ice-9 textual-ports)))


(define decrypt-u8
  (λ (u8 pos secret-vector payload-offset)
    "Decrypt a character based on its position, a payload offset, and secret. "
    (let* ([key-length (vector-length secret-vector)]
           [pos-in-key
            ;; For each byte to decrypt use one character of the secret. Go back
            ;; to the first character of the secret again, when the key has no
            ;; more characters left. Alternative explanation: Use the secret as
            ;; a ring.
            (remainder (- pos payload-offset) key-length)])
      ;; Output a decrypted character.
      (integer->char
       ;; substract from the encrypted u8 or byte the byte of the corresponding
       ;; character of the secret.
       (- u8
          (vector-ref secret-vector pos-in-key))))))


(define decrypt-file
  (lambda* (#:optional (fport (current-input-port))
            #:key
            (secret "odBearBecauseHeIsVeryGoodSiuHungIsAGo")
            ;; for some reason (obfuscation?) the first 123 bytes are
            ;; trash
            (num-ignored-bytes 123)
            (verbose #f))
    "Provided a file port, read byte after byte, decrypting
them, until all bytes are decrypted and the file ends."
    (let ([secret-vector
           (list->vector
            (map char->integer
                 (string->list secret)))])
      ;; Write decrypted bytes to a string, avoiding using string-append for
      ;; each character.
      (call-with-output-string
        (λ (string-port)
          ;; For some reason (obfuscation of the encryption algorithm?) the
          ;; first n bytes of a data file are trash.
          (log:debug "skipping trash bytes at the start of the file")
          (log:debug "trash bytes:" (get-bytevector-n fport num-ignored-bytes))

          (let iter ([char-index num-ignored-bytes] [u8 (get-u8 fport)])
            (log:debug "char-index:" char-index #:verbose verbose)
            (cond
             [(eof-object? u8)
              (log:debug "end of file reached" #:verbose verbose)
              (put-string string-port "")]
             ;; Otherwise decrypt the character.
             [else
              (let ([decrypted-char
                     (decrypt-u8 u8 char-index secret-vector num-ignored-bytes)])
                (log:debug "read u8:" u8 "character:" (integer->char u8) "decrypted:" decrypted-char #:verbose verbose)
                (put-char string-port decrypted-char))
              (iter (+ char-index 1)
                    (get-u8 fport))])))))))