lf2-data-crypt/lf2-data-crypt.scm

(library (lf2-data-crypt)
  (export
   trash-bytes
   shift
   reverse-shift
   ;; crypt-u8
   decrypt-u8
   encrypt-u8

   decrypt
   encrypt

   secret->vector)
  (import
    (except (rnrs base) let-values)
    (only (guile)
          lambda* λ
          error
          eof-object?
          simple-format
          current-output-port
          current-input-port
          call-with-output-string
          call-with-input-string
          call-with-output-file
          remainder
          array-for-each
          array-ref)
    (prefix (logging) log:)
    (ice-9 binary-ports)
    ;; Bytevectors are created by procedures from (ice-9 binary-ports), but to
    ;; work with them, other imports are needed.
    (rnrs bytevectors)
    (ice-9 textual-ports)
    (port-utils)
    (bytevector-utils)))


;; At the beginning of the stage.dat file there are 123 bytes of data, which
;; have either unknown meaning, or are simply trash, possibly serving as a means
;; of obfuscation.
(define trash-bytes
  #vu8(160 176 182 147 194 175 185 146 189 144 160 197 190 183 142 181 174 202 139 178 175 182 193 186 169 152 171 152 183 157 180 183 194 147 177 180 175 155 185 184 143 197 198 191 146 181 147 157 189 181 170 136 188 181 181 138 167 170 169 189 188 186 157 188 145 204 161 169 184 195 154 194 184 176 153 170 201 137 190 196 172 140 200 153 146 191 187 169 152 188 182 180 154 166 187 180 196 180 189 152 170 154 191 165 180 183 198 139 182 200 185 158 183 200 161 205 194 186 140 191 142 144 195))

(define default-secret "odBearBecauseHeIsVeryGoodSiuHungIsAGo")


(define secret->vector
  (λ (secret)
    "Transform the secret, which is a string into a vector, containing the
unsigned 8 bit integer values of the secret key characters."
    ;; TODO: Actually this vector could contain other things than only unsinged
    ;; 8 bit integers. It could contain any integer. Perhaps a true bytevector
    ;; should be used?
    (list->vector
     (map char->integer
          (string->list secret)))))


(define shift
  (lambda* (int amount #:key (rest-class 256))
    "Shift a single unsigned 8 bit integer by the given amount, modulo the
specified rest-class."
    (remainder (+ int amount) rest-class)))


(define reverse-shift
  (lambda* (int amount #:key (rest-class 256))
    "Reverse shift a single unsigned 8 bit integer by the given amount, modulo
the specified rest-class."
    (let ([reverse-shifted (shift int (* amount -1) #:rest-class rest-class)])
      ;; The reverse shifted integer could be negative, so we add 128. If it was
      ;; already a positive number, then adding 128 would make it leave the
      ;; bounds specified by rest-class, so we need to calculate the remainder
      ;; again.
      (remainder (+ reverse-shifted rest-class) rest-class))))


(define crypt-u8
  (lambda* (u8 index-in-input secret-vector #:key (shift-proc shift))
    "Decrypt a character based on its position, a payload offset, and secret."
    (let* ([key-length (bytevector-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 index-in-input key-length)])
      ;; substract from the encrypted u8 or byte the byte of the corresponding
      ;; character of the secret.
      (shift-proc u8
                  (array-ref secret-vector pos-in-key)
                  #:rest-class (expt 2 8)))))


(define decrypt-u8
  (λ (u8 index-in-input secret-vector)
    "Decrypt an unsigned 8 bit integer based on its position, a payload offset,
and secret."
    (crypt-u8 u8
              index-in-input
              secret-vector
              #:shift-proc reverse-shift)))


(define encrypt-u8
  (λ (u8 index-in-input secret-vector)
    "Encrypt an unsigned 8 bit integer based on its position, a payload offset,
and secret."
    (crypt-u8 u8
              index-in-input
              secret-vector
              #:shift-proc shift)))


(define decrypt
  (lambda* (#:key
            (port (current-input-port))
            (secret default-secret)
            ;; 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."
    (log:debug "decrypting file\n")
    (let ([secret-vector (string->bytevector 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 port num-ignored-bytes))

          (port-u8-for-each (λ (index u8)
                              (let ([decrypted-char
                                     (integer->char
                                      (decrypt-u8 u8 index secret-vector))])
                                (put-char string-port decrypted-char)))
                            port))))))


(define encrypt
  (lambda* (plain-text
            #:key
            (port (current-output-port))
            (secret default-secret)
            (trash-bytes trash-bytes)
            (verbose #f))
    "Provided a file port, encrypt bytewise and write bytes to the file port,
until all bytes are written."
    (let ([secret-vector (string->bytevector secret)]
          [payload-offset (bytevector-length trash-bytes)])
      ;; Read string from port, to avoid having to use substring for each
      ;; character.
      (call-with-input-string plain-text
        (λ (string-port)
          ;; Write encrypted bytes to a file port, avoiding using string-append
          ;; for each character.
          ;; Write trash bytes first.
          (log:debug "putting trash bytes\n")
          (array-for-each (λ (u8) (put-u8 port u8)) trash-bytes)
          (log:debug "trash bytes put\n")

          ;; Write encrypted text to output port.
          (port-u8-for-each (λ (index u8)
                              (put-u8 port
                                      (encrypt-u8 u8 index secret-vector)))
                            string-port))))))