#lang racket/base
;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2018-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>

(provide file->ssh-private-key
         bytes->ssh-private-key)

(require racket/match)
(require (only-in racket/file file->bytes))
(require (only-in racket/port call-with-input-bytes))
(require (only-in racket/string string-join))

(require net/base64)
(require bitsyntax)
;; (require blowfish/bcrypt-hash)
(require crypto)

(require "../ssh-message-types.rkt")

(define (file->ssh-private-key filename [passphrase-bytes #f])
  (bytes->ssh-private-key (file->bytes filename) passphrase-bytes))

(define (bytes->ssh-private-key bs [passphrase-bytes #f])
  (call-with-input-bytes
   bs
   (lambda (p)
     (and (equal? (read-line p) "-----BEGIN OPENSSH PRIVATE KEY-----")
          (let ((blob (let collect ((acc '()))
                        (match (read-line p)
                          ["-----END OPENSSH PRIVATE KEY-----"
                           (base64-decode (string->bytes/latin-1 (string-join (reverse acc))))]
                          [line
                           (collect (cons line acc))]))))
            (bit-string-case blob
              ([ (= #"openssh-key-v1\0" :: binary bytes 15)
                 (ciphername :: (t:string #:pack))
                 (kdfname :: (t:string #:pack))
                 (kdfoptions :: (t:string #:pack))
                 (= 1 :: bits 32) ;; OpenSSH only supports one key
                 (public-keys :: (t:repeat 1 (t:string #:pack)))
                 (private-keys :: (t:string #:pack)) ]
               (decode-private-keys passphrase-bytes
                                    ciphername
                                    kdfname
                                    kdfoptions
                                    (car public-keys)
                                    private-keys))
              (else #f)))))))

(define (decode-private-keys passphrase-bytes
                             ciphername
                             kdfname
                             kdfoptions
                             public-key
                             private-keys)
  (define pk-bytes
    (bit-string-case public-key
      ([ (= #"ssh-ed25519" :: (t:string #:pack))
         (bs :: (t:string #:pack)) ]
       bs)))
  (define (decode-decrypted blob)
    ;; Oddly, this only partially lines up with the spec at
    ;; https://cvsweb.openbsd.org/cgi-bin/cvsweb/src/usr.bin/ssh/PROTOCOL.key?annotate=1.1
    ;;
    ;; Specifically, contra spec, after the checkints, we seem to have
    ;; the public key again followed by the private key bytes and then
    ;; a comment string.
    ;;
    ;; The code (sshkey.c) does this:
    ;;  - retrieve a key type string
    ;;  - dispatch on it
    ;;  - for ed25519, read a string with the PK, then a string with the SK
    ;;  - checks the sizes to ensure they are correct for ed25519
    ;;
    ;; This is what the PROTOCOL.key documentation says to do. It's
    ;; not what actually needs to be done.
    ;;
    ;; [ (checkint1 :: bits 32) (= checkint1 :: bits 32) ;; must be the same
    ;;   (keys :: (t:repeat 1 (t:repeat 2 (t:string #:pack))))
    ;;   (= 'padding-ok :: (t:padding)) ]
    ;;
    (bit-string-case blob
      ([ (checkint1 :: bits 32) (= checkint1 :: bits 32) ;; must be the same
         (= #"ssh-ed25519" :: (t:string #:pack))
         (pk-bytes-in-sk :: (t:string #:pack))
         (sk :: (t:string #:pack))
         (comment :: (t:string #:pack))
         (= 'padding-ok :: (t:padding))
         ]
       (and (equal? pk-bytes pk-bytes-in-sk)
            (list pk-bytes sk (bytes->string/utf-8 comment))))
      (else #f)))
  (match* (ciphername kdfname)
    [(#"none" #"none")
     (decode-decrypted private-keys)]
    ;; This stanza works, I just don't want to depend on bcrypt just yet:
    #;[(#"aes256-ctr" #"bcrypt")
     (define keylen (/ 256 8)) ;; aes256 = 256 bit key length
     (define ivlen (/ 128 8)) ;; fixed block size of 128 bits
     (bit-string-case kdfoptions
       ([ (salt :: (t:string #:pack))
          (rounds :: bits 32) ]
        (when (not passphrase-bytes) (error 'read-ssh-private-key "Passphrase required"))
        (bit-string-case (bcrypt-pbkdf passphrase-bytes salt (+ keylen ivlen) rounds)
          ([ (key :: binary bytes keylen) (iv :: binary bytes ivlen) ]
           (decode-decrypted
            (parameterize ((crypto-factories (list libcrypto-factory)))
              (decrypt '(aes ctr) (bit-string->bytes key) (bit-string->bytes iv) private-keys)))))))]
    [(_ _)
     (error 'read-ssh-private-key "Unsupported private-key cipher/kdf")]))