;;;; Encrypted storage of Yenta's persistent state.

;;;; See Yenta/Internal/Documentation/HTML/Security/eptobs.html for the overall algorithm.
;;;; All crypto here uses IDEA-CBC, since that's how ePTOBs are defined.

;;; Note that we -must not call eval- on anything that is written -outside- the crypto
;;; envelope, since otherwise someone could rewrite those entries to, e.g., redefine
;;; the crypto functions themselves to hijack the Yenta or something weird like that.
;;; Thus, we can -identify- what variables are what, or just -assume- the order in
;;; which they appear, but we -cannot- use, e.g., "(define *foo* 3)" as is done when
;;; inside the crypto envelope.
;;;
;;; At the moment, we write the values outside of the envelope in a known order,
;;; starting with the file format version number.  This allows us to change formats
;;; in the future.  We don't bother to indicate in the file which value is which
;;; (e.g., we just write "foo", not "(*foo* "foo")" or whatever), because (a) that's
;;; supposed to be invariant with the version number, and (b) writing, e.g.,
;;; "(*httpd:private-key* "lsdflsdjf")" would just needlessly panic a user who
;;; decided to look at the file---it's not his -identity- private key, but try
;;; explaining that to a worried user!

;;;; General crypto.

;;; This stuff is lumped together here, rather than being broken into the saving
;;; half and the restoring half, to keep each piece and its partner near each other.

(define (vars:vars-scm-crypt-pathname)
  (yenta-name "vars.scm.crypt"))

;;; Current version of the file format.
(define *vars:encryption-version* 1)

;;; Global used while verifying a saved state, which is done immediately after writing it.
(defvar *vars:crypto-hash* #f)		; The SHA-1 hash of <VkVk, protocol-version-k, Dk> as it was written to disk.

;;; Whether or not the latest save succeeded, to be read by alerts:statefile-save-failure, vars:save-and-load, and maybe others.
;;; Note that we start off assuming that we succeeded, just so we don't have to be clever about the boundary startup cases.
;;; This will get set #f if we try a save and anything goes wrong.
(defvar *vars:verification-succeeded?* #t)

;;; Get the key, Ph, we'll use to encrypt/decrypt the session key, K.
(define (vars:hashed-passphrase-to-key)
  (crypt:make-key
   (substring *hashed-passphrase* 0 16))) ; The hashed passphrase is 20 bytes long, since it was hashed with SHA-1, but IDEA uses 16-byte keys.

;;; Return a list of K and V, as strings.
(define (vars:generate-session-and-verifier)
  (let ((nbits (+ 128 64)))		; Session key is 128 bits; verifier is 64.
    (ssl:err-if-randbits-unavailable
     nbits
     "We wanted ~S random bit~:P to generate a session key and verifier, but only had ~S available."
     nbits (ssl:randbits-in-pool))
    (ssl:eat-randbits! nbits))
  (list (ssl:random-data 16) (ssl:random-data 8)))

;;; ++ Session key management.
(define (vars:encrypt-session-key k)	; Encrypts K, using Ph as the key, producing Kp.
  (let ((nbits 64))			; IV is 64 bits.
    (ssl:err-if-randbits-unavailable
     nbits
     "We wanted ~S random bit~:P to generate a session-key IV, but only had ~S available."
     nbits (ssl:randbits-in-pool))
    (ssl:eat-randbits! nbits))
  (let* ((key (vars:hashed-passphrase-to-key))
	 (ec (crypt:make-encrypt-context key)))
    (call-with-output-string
      (lambda (port)
	(let ((wcf (crypt:open-write ec port)))
	  (vars:write-key k wcf)
	  (close-port wcf))))))

(define (vars:decrypt-session-key kp)	; Decrypts Kp, using Ph as the key, producing K.
  (let* ((key (vars:hashed-passphrase-to-key))
	 (dc (crypt:make-decrypt-context key))
	 (k #f))
    (call-with-input-string
	kp
      (lambda (port)
	(let ((rcf (crypt:open-read dc port)))
	  (set! k (vars:read-key rcf))
	  (close-port rcf))))
    k))

;;;; Byte-string I/O.

;;; Some objects can use read and write, and some can't.  The browser cert
;;; can be read/written, because it's outside the crypto, so we know we can reliably
;;; surround it with quotes, etc.  The actual persistent state D can also be read/written,
;;; because, by the time we're reading it, we're guaranteed to have a valid decrypting stream,
;;; and so for all intents and purposes it's just like we're reading it from the plaintext.
;;;
;;; But the verifier -cannot- be read/written, because of what happens if the passphrase is
;;; incorrect.  If the passphrase is correct, fine, no problem, the decrypting stream will
;;; correctly decrypt any quotes around V1V2, and we'll be able to call read on them.  But
;;; if the passphrase is wrong, then we'll be decrypting garbage, and hence there -won't-
;;; be any quotes around V1V2.  This means that read will barf with very high probability;
;;; after all, there's no guarantee that it won't find an open paren with no close, etc.
;;; [It's also good form not to surround V1V2 with quotes, because such quotes would be
;;; a bit of known plaintext in a known position.  This isn't as big an issue, because
;;; (a) we assume IDEA-CBC is resistant to a KP attack, and (b) there's plenty of known
;;; plaintext around in the actual forms we've saved anyway.]
;;;
;;; Similarly, Kp can't be read/written, because, if we use write, it will be surrounded
;;; by double-quotes, which will be encrypted when we encrypt the key, and will come back
;;; when we successfully decrypt it.  But if we incorrectly decrypt due to a bad P, it
;;; will come back as something random, hence unreadable.
;;;
;;; Thus, we must do byte-by-byte I/O for the verifier and for Kp.  This is fairly simple,
;;; especially since we know exactly how long they are---always 8 bytes for a verifier,
;;; and 16 bytes for Kp.

(define (vars:write-bytes s port n)	; %%% Just assumes s is long enough---will blow out if not!
  (do ((i 0 (1+ i)))
      ((= i n))
    (write-char (string-ref s i) port)))

(define (vars:read-bytes port n)	; Returns it as a string.
  (do ((s (make-string n))
       (i 0 (1+ i)))
      ((>= i n) s)
    (let ((c (read-char port)))
      (cond ((eof-object? c)		; If we hit EOF, ...
	     (set! s (substring s 0 i))	; ... return a truncated string, to warn the caller, ...
	     (set! i n))		; ... and terminate the loop immediately.
	    (t
	     (string-set! s i c))))))	; Otherwise, stick the character into the string.

(define (vars:write-verifier v port)
  (vars:write-bytes v port 8))

(define (vars:read-verifier port)
  (vars:read-bytes port 8))

(define (vars:write-key k port)
  (vars:write-bytes k port 16))

(define (vars:read-key port)
  (vars:read-bytes port 16))

;;; Sucks in a string from port, handling quoting.  If we don't see a
;;; quote right at the start, or if we run off the file before we see
;;; the closing quote, we return #f.  The point is to guarantee that
;;; we read a string, without actually calling read, because read
;;; is vulnerable to the #. reader macro making us evaluate something
;;; at read-time---like a proceduure that will compromise Yenta.  If
;;; we're already inside the crypto envelope, read or even eval are
;;; safe, since by definition only we could have written that data.
;;; (An attacker who can break the encryption surely doesn't need to
;;; screw around with #. subterfuge.)  But -outside- the crypto envelope,
;;; we'd be vulnerable to a scheme programmer with a text editor.
(define (vars:fake-read-string port)
  (let ((exp (sr:make-string 1000))
	(done #f)
	(quoting #f))
    (do ((char (peek-char port) (peek-char port))) ; Skip any leading whitespace; this lets me put newlines between strings if I want.
	((or (eof-object? char)
	     (not (char-whitespace? char))))
      (read-char port))			; Actually read the character, so we can get the next one.
    (cond ((not (eq? (read-char port) #\")) #f) ; Didn't start with a quote.
	  (t
	   (do ((char (or done (read-char port)) (or done (read-char port)))) ; Don't swallow one character too many if we're done.
	       (done
		(if exp
		    (sr:to-string exp)
		    #f))
	     (cond ((eof-object? char)	; Must have run off the end.
		    (set! exp #f)
		    (set! done #t))
		   (quoting
		    (sr:add-char! char exp)
		    (set! quoting #f))
		   ((eq? char #\\)
		    (set! quoting #t))	; Slashified character coming up.
		   ((eq? char #\")
		    (set! done #t))	; End of the string.  If the quote was quoted, it would have been caught above.
		   (t
		    (sr:add-char! char exp))))))))

;;; Returns #f if it either got an error reading, or if the thing it read wasn't a number.
;;; Otherwise, returns a number.
(define (vars:fake-read-string->number port)
  (let ((s (vars:fake-read-string port)))
    (if (string? s)
	(string->number s)
	#f)))

;;;; Saving state.

(define (vars:save-to-eptob eptob)
  (for-each (lambda (var-rec)
	      (cond ((null? (cdr var-rec))
		     (write `(define ,(car var-rec) ',(eval (car var-rec))) eptob)
		     (newline eptob))
		    (t
		     (write ((eval (cadr var-rec)) (car var-rec)) eptob)
		     (newline eptob))))
	    *vars:vars*)
  (write `(define *vars:vars* ',*vars:vars*) eptob)
  (newline eptob))

;;; Even a disk-full won't cause an error during these writes, so you should call vars:verify-encrypted
;;; immediately afterwards, before renaming the tempfile and obliterating the last known-good statefile.
(define (vars:write-preamble-and-data file)
  (let* ((k-and-v (vars:generate-session-and-verifier))
	 (k (car k-and-v))		; Oh for destructuring-bind, or multiple-value-bind.
	 (v (cadr k-and-v))
	 (kp (vars:encrypt-session-key k)))
;   (format t "~&K  = ~S~&V  = ~S~&Kp = ~S~&" k v kp) ; DEBUG.
    ;; Things written here are -outside- the crypto.
    (write (number->string *vars:encryption-version*) file) ; This is repeated in the crypto envelope, to prevent weird version-rollback spoofs.
    (write kp file)			; Save the encrypted session key, Kp.
    (write *httpd:cert* file)		; We need these two guys so we can get an SSL session up on the user's browser, ...
    (write *httpd:private-key* file)	; ... to ask for the passphrase, -without- forcing the user to accept a brand new cert.
    ;; Everything written after this point is -inside- the crypto.
    (let ((nbits 64))			; IV is 64 bits.
      (ssl:err-if-randbits-unavailable
       nbits
       "We wanted ~S random bit~:P to generate a main-crypto IV, but only had ~S available."
       nbits (ssl:randbits-in-pool))
      (ssl:eat-randbits! nbits))
    (let* ((key (crypt:make-key k))
	   (ec (crypt:make-encrypt-context key)))
      (let ((crypto-data		; This is VkVk, the crypted version number, and Dk, all concatenated together.
	     (call-with-output-string
	       (lambda (port)
		 (let ((wcf (crypt:open-write ec port)))
		   ;; Emit the paired verifiers, VV, which will turn into VkVk by virtue of the ePTOB.
		   (vars:write-verifier v wcf)
		   (vars:write-verifier v wcf)
		   ;; The version number again, so an attacker can't turn back the clock on file versions
		   ;; by editing the unencrypted copy, and cause us to use some format we've abandoned.
		   (write (number->string *vars:encryption-version*) wcf)
		   ;; Now write out the persistent state, D, turning it into Dk by virtue of the ePTOB.
		   (vars:save-to-eptob wcf)
		   (close-port wcf))))))
	(set! *vars:crypto-hash* (ssl:sha1-hash crypto-data)) ; For use by vars:verify-encrypted only.
	(write crypto-data file)))))

;;; Actually saves our encrypted state.  This uses vars:verify-encrypted to make sure that the
;;; data was written correctly.  Note that it doesn't return any useful value; you'll have to
;;; check *vars:verification-succeeded?* to see if it really worked.
;;;
;;; *** The order of fields in vars:load-browser-cert, vars:load-encrypted, vars:save-encrypted, ***
;;; *** and vars:verify-encrypted must stay in sync for any given protocol version! ***
(define (vars:save-encrypted)
  (let* ((base (vars:vars-scm-crypt-pathname))
	 (name (format nil "~A.~A" base (getpid)))
	 (file (open-output-file name)))
    ;; First, get the data committed to disk.
    (vars:write-preamble-and-data file)
    (close-port file)
    ;; Second, verify the data written.
    (let ((file (open-input-file name)))
      (vars:verify-encrypted file)
      (close-port file))
    ;; Third, put it in the right file, iff the data's good, or punt the tempfile if not.
    (cond (*vars:verification-succeeded?* ; The data was good.
	   (let ((succeeded? (rename-file name base)))	; %%% I don't know what to do with an error!  Log it?  Try again?
	     (unless succeeded?
	       (logger:log-and-display 0 "Couldn't rename ~A to ~A while saving state." name base))))
	  (t				; The data was bad.
	   (delete-file name)))))	; Get rid of it, in case the problem was that we ran out of disk---don't contribute to the mess!

;;; Call this immediately after a brand-new Yenta has generated its keys.  Actually loading the
;;; saved state is what opens certain databases (I think!), and doing so also guarantees that
;;; vars:load-encrypted-internal will set *vars:successfully-loaded-everything*, which is
;;; -very important- to prevent us from attempting to reload our already-loaded state if
;;; we ask for a passphrase for a decayed session---doing so will blow out in open-database, and
;;; probably elsewhere, too.
;;;
;;; We call "error" here, instead of trying to use the UI, because this is -only- called just
;;; after key generation, and Yenta hasn't yet instructed the user to go load a URL.  That means
;;; we don't even have a web browser yet, and the user is still staring a the tty.
(define (vars:save-and-load-encrypted)
  (vars:save-encrypted)
  (cond (*vars:verification-succeeded?* ; Saved successfully, so go ahead and reload.
	 (let ((result (vars:try-loading-encrypted)))
	   (unless (eq? (car result) 'ok)
	     (error (format nil "vars:save-and-load-encrypted got ~S when reloading,~&~
                                 which should be impossible.  Please report this internal error~&~
                                 by sending mail to bug-yenta@media.mit.edu, and include the~&~
                                 exact text of this message.  [This is Yenta ~A, under ~A.]"
			    result
			    (ui:yenta-version)
			    (ui:yenta-uname))))))
	(t				; Didn't save successfully.
	 (error (format nil "Yenta was unable to save its internal state after generating keys.~&~
                             Since it did manage to at least create ~A, this is~&~
                             probably not a file-permissions problem.  Instead, it is likely that~&~
                             the disk is full, or very nearly so, and Yenta ran out of space.~&~
                             Please fix the situation and try starting Yenta again.~&"
			(yenta-name ""))))))

;;;; Restoring state.

;;; Set #t once we have actually successfully loaded everything from the
;;; vars.scm.encrypted file.  If this is -not- #t, -you must not save-, since
;;; doing so might trash an otherwise valid file with incompletely-read data.
;;;
;;; This is also used to prevent -reloading- everything if vars:try-loading-encrypted
;;; gets called more than once.  This is certainly possible, since we might wind up
;;; calling it just to check a passphrase after an old session decayed.
(defvar *vars:successfully-loaded-everything* #f) ; Don't bash this if this file gets reloaded during debugging.

;;; A combination of try-load and and eval that works on arbitrary ports
;;; instead of files.  It loads each form it finds from the port until EOF.
;;; This is somewhat inefficient 'cause load-string keeps making string-ports
;;; and calling lread() on them; the right thing would be if SCM supported
;;; this natively, by excising the relevant code from the guts of tryload().
;;; Perhaps I'll write this at some point.
(define (vars:load-from-port port)
  (let ((form (read port)))		; Safe 'cause reading encrypted data here---only we could have written it.
    (unless (eof-object? form)
;     (format t "~&Loading ~S~&" form)	; DEBUG.
      (eval form)			; Ditto safe here.
      (vars:load-from-port port))))

(define (vars:load-from-port-noting-result port)
  (vars:load-from-port port)
  (set! *vars:successfully-loaded-everything* #t))

;;; Get the browser cert, only, so the UI can get an SSL connection up to ask for the passphrase.
;;; Returns (cons #t <version-found>) if it succeeded, and (cons #f <version-found>) if not.
;;;
;;; *** The order of fields in vars:load-browser-cert, vars:load-encrypted, vars:save-encrypted, ***
;;; *** and vars:verify-encrypted must stay in sync for any given protocol version! ***
(define (vars:load-browser-cert)
  (let* ((name (vars:vars-scm-crypt-pathname))
	 (file (open-input-file name))	; This must succeed or we'll get an error; something -else- should verify that it's there...
	 (version (vars:fake-read-string->number file)))
    (case version
      ((1) (vars:fake-read-string file)
	   (cond (*vars:successfully-loaded-everything*
		  ;; If we've already loaded successfully, we must be doing this just to recheck a passphrase after the session decayed.
		  ;; So don't bash the existing certs, these even though their replacements -should- be identical...
		  ;; [Actually, I'm not convinced that vars:load-browser-cert, as opposed to vars:load-encrypted-internal,
		  ;;  can ever be called to check a passphrase, but better safe than sorry.]
		  (format-debug 0 "~%vars:load-browser-cert called, but we already loaded everything.~&"))
		 (t
		  (set! *httpd:cert* (vars:fake-read-string file))
		  (set! *httpd:private-key* (vars:fake-read-string file))))
	   (close-port file)
	   (cons #t version))
      (else				; Unknown version, including getting #f from fake-read-string->number, meaning garbage.
       (close-port file)
       (cons #f version)))))

;;; This function must be called -after- we have prompted the user for the passphrase!
;;; It returns a cons whose car is one of the following:
;;;   'ok:  the verifiers matched (which means it read the read of the file)
;;;   'mismatch:  the verifiers didn't match (the user probably mistyped the passphrase)
;;;   'unknown-version:  we couldn't figure out what to do with this file version
;;;      (shouldn't happen, since it implies this is an old Yenta looking at a newer file)
;;;   'version-spoof:  the encrypted and plaintext versions didn't match (barring some
;;;       horrendous bug, it means somebody edited the plaintext and the user is under attack)
;;; ...and whose cdr is either #f for 'ok or 'mismatch, or additional information
;;; for the other two cases.
;;;
;;; Its single argument is function to call, which takes as its argument a stream
;;; from which plaintext will arrive.  Generally, this should be vasr:load-from-port,
;;; but it could be different for debugging---in particular, for vars:dump-encrypted.
;;; The work-fn should -not- close its input stream!  Leave that for the caller, e.g., us.
;;;
;;; *** The order of fields in vars:load-browser-cert, vars:load-encrypted, vars:save-encrypted, ***
;;; *** and vars:verify-encrypted must stay in sync for any given protocol version! ***
(define (vars:load-encrypted-internal work-fn)
  (format-debug 0 "~%vars:load-encrypted-internal.~&")
  (let* ((name (vars:vars-scm-crypt-pathname))
	 (file (open-input-file name))	; %%% This must succeed or we'll get an error; something -else- should verify that it's there...
	 (version (vars:fake-read-string->number file)))
    (case version			; [If we start having multiple protocols, it's probably worth making each case its own function.]
      ((1) (let ((kp (vars:fake-read-string file))) ; Get the encrypted session key, Kp.
	     (vars:fake-read-string file) ; Throw this away; we don't use it here.
	     (vars:fake-read-string file) ; Ditto.
	     (let* ((k (vars:decrypt-session-key kp)) ; Decrypt Kp with the hashed passphrase, Ph, to regenerate the session key, K.
		    ;; %%% Think about what happens if it decrypts wrong and is somehow too short for v:d-s-k to run??  Can this happen?
		    (key (crypt:make-key k))	; Turn K into a real key.
		    (dc (crypt:make-decrypt-context key)) ; Set up a decryption context using it.
		    (crypto (vars:fake-read-string file))) ; Read all the rest of the file, consisting only of encrypted data, into a string.
;	       (format t "~&Kp = ~S~&K  = ~S~&" kp k) ; DEBUG.
	       (call-with-input-string
		   crypto
		 (lambda (port)
		   (let ((rcf (crypt:open-read dc port)))
		     (let* ((v1 (vars:read-verifier rcf))
			    (v2 (vars:read-verifier rcf)))
;		       (format t "~&V1 = ~S (~S)~&V2 = ~S (~S)~&" v1 (string-length v1) v2 (string-length v2)) ; DEBUG.
		       (cond ((equal? v1 v2)
			      (let ((crypted-version (vars:fake-read-string->number rcf)))
				(cond ((equal? crypted-version version)
				       (cond (*vars:successfully-loaded-everything* ; We must just be checking a passphrase for a decayed session.
					      (format-debug 0 "~%vars:load-encrypted-internal called, but we already loaded everything.~&"))
					     (t
					      (work-fn rcf))) ; Actually read and evaluate (e.g., load) the persistent state.
				       (close-port rcf)
				       (close-port file)
				       (cons 'ok 'ok))
				      (t ; Encrypted and plaintext versions didn't match---someone edited the file.
				       (close-port rcf)
				       (close-port file)
				       (cons 'version-spoof (cons version crypted-version))))))
			     (t		; Verifiers didn't match---presumably, the user mistyped the passphrase.
			      (close-port rcf)
			      (close-port file)
			      (cons 'mismatch #f))))))))))
      (else				; Unknown version.
       (close-port file)
       (cons 'unknown-version version)))))

;;; The real toplevel.
(define (vars:load-encrypted)
  (vars:load-encrypted-internal vars:load-from-port-noting-result))

;;;; Doing verification.

;;; It is -absolutely essential- that the statefile be written completely without error,
;;; since anything that trashes it will destroy the user's private key, hence his identity,
;;; and thus his reputation (because he'll lose others' signatures on his attestations).
;;; This is an intolerable state of affairs.  Yet SCM does not check any of its C calls when
;;; writing streams; this means that a common error such as disk-full would go entirely
;;; undetected.  Instead, we check the preamble here, and also a hash of the encrypted
;;; data which was computed seconds before when the data was written, and scream if they
;;; don't match.  This will keep vars:save-encrypted from renaming a bad tempfile over
;;; an older good statefile.
;;;
;;; This routine is basically the outside of vars:load-encrypted-internal, adapted to actually
;;; notice the browser cert and browser private key, and to compare hashes on the crypto data.
;;; Because we might have to support multiple protocol versions, it was easier to abstract the
;;; code than to try to make some wrapper function that both used---such a wrapper would have
;;; contend somehow with the "case version" below.
;;;
;;; Note that running out of space while writing the preamble might lead to an unterminated
;;; string (since, after all, it's likely to be missing its closing quote).  This will cause
;;; the various read routines to return #f instead of a string, so we have to be careful to check.
;;;
;;; This routine DOES NOT RETURN A USEFUL VALUE.  Check *vars:verification-succeeded?* afterwards.
;;;
;;; *** The order of fields in vars:load-browser-cert, vars:load-encrypted, vars:save-encrypted, ***
;;; *** and vars:verify-encrypted must stay in sync for any given protocol version! ***
(define (vars:verify-encrypted file)	; The -caller- is responsible for opening -and- closing this port, which is presumably a tempfile.
  (format-debug 0 "~%vars:verify-encrypted.~&")
  (set! *vars:verification-succeeded?* #f) ; As far as we're concerned, we've failed until it's proven that we've succeeded.
  (let ((version (vars:fake-read-string->number file)))
    (case version			; [If we start having multiple protocols, it's probably worth making each case its own function.]
      ((1) (let ((kp (vars:fake-read-string file)) ; Get the encrypted session key, Kp.
		 (cert (vars:fake-read-string file))
		 (priv (vars:fake-read-string file)))
	     (cond ((and (string? cert) (string? priv)
			 (string=? cert *httpd:cert*)  ; We assume that the real variables won't change out from under us ...
			 (string=? priv *httpd:private-key*)) ; ... between the save and the verify, which should be seconds apart.
		    (let* ((k (vars:decrypt-session-key kp)) ; Decrypt Kp with the hashed passphrase, Ph, to regenerate the session key, K.
			   ;; %%% Think about what happens if it decrypts wrong and is somehow too short for v:d-s-k to run??  Can this happen?
			   (key (crypt:make-key k))	; Turn K into a real key.
			   (dc (crypt:make-decrypt-context key)) ; Set up a decryption context using it.
			   (crypto (vars:fake-read-string file)) ; Read all the rest of the file, consisting only of encrypted data, into a string.
;			   (hash (ssl:sha1-hash (substring crypto 1 (string-length crypto)))) ; DEBUG!  Trash the file by losing a byte.
			   (hash (and (string? crypto)
				      (ssl:sha1-hash crypto))))
		      (cond ((and (string? hash)
				  (string=? hash *vars:crypto-hash*))
			     (format-debug 0 "~&Verification succeeded.~&")
			     (set! *vars:verification-succeeded?* #t)) ; We win!
			    (t
			     (format-debug 0 "~&Hash mismatch!~&~S while reading~&~S while writing~&" hash *vars:crypto-hash*)))))
		   (t
		    (format-debug 0 "~&Cert or priv mismatch!~&Cert real:  ~S~&Cert read:  ~S~&Priv real:  ~S~&Priv read:  ~S~&"
				  cert *httpd:cert* priv *httpd:private-key*)))))
      (else		; Unknown version.  Since we just wrote the file, this is a failure, too.
       (when version	; If it wasn't #f (meaning unterminated string, meaning disk full at the very start), then this can't be right.
	 (format-debug 0 "~&Unknown version ~S during verification, which can't happen.~&" version))))))

;;;; Calling the loader and checking for errors.

;;; We make the design decision here that any serious error in loading the saved state
;;; is fatal, and should be reported to stderr, not to the browser.  (After all, there's
;;; no guarantee that the browser might even be up yet.)  Failing to find the file is
;;; -not- fatal, since any brand-new Yenta is in that situation.  But version mismatches,
;;; corrupted format, etc etc, are definitely grounds for just killing the image immediately.

;;; This either returns #t, in which case it thinks it found a valid file for which it's worth
;;; asking for a passphrase, or #f, if it didn't find any file at all.  If it fins an invalid
;;; file, it kills the image, since we can't even get started trying to get a browser connection
;;; up, but there's a config file that claims we should have been able to.
(define (vars:try-loading-browser-cert)
  (format-debug 0 "~%vars:try-loading-browser-cert.~&")
  (cond ((file-exists? (vars:vars-scm-crypt-pathname)) ; If it's not there, do without it---this must be the first time the user's run us.
	 (let* ((result (vars:load-browser-cert))
		(status (car result))
		(maybe-version (cdr result)))
	   (unless status
	     (cond ((and (number? maybe-version) ; Might be #f if the file is trash and doesn't start with 2 digits.
			 (< *vars:encryption-version* maybe-version)) ; Some newer version than we've ever heard of.
		    (error (format nil "~%~A, which holds Yenta's~&~
                                        configuration information, is in an unrecognized format.~&
                                        It was apparently written by some some later version of Yenta,~&~
                                        using a version ~A file format, but this Yenta can only understands~&~
                                        version ~A or earlier.  Either you are now running an older version~&~
                                        of Yenta than you used to, or someone has edited the file---in which~&~
                                        case you're going to have to find a backup of it.  Sorry.~&"
				   (vars:vars-scm-crypt-pathname)
				   maybe-version
				   *vars:encryption-version*)))
		   (t			; Not a number or something.  (We should have been able to cope with an older version.)
		    (error (format nil "~%~A, which holds Yenta's~&~
                                        configuration information, is in an unrecognized format.~&
                                        It doesn't even look like Yenta wrote this file at all.~&
                                        If someone created this file before Yenta ever ran, you~&
                                        should get rid of it and try again.  If you have run Yenta~&
                                        before, then someone has edited the file---in which case~&~
                                        you're going to have to find a backup of it.  Sorry.~&"
				   (vars:vars-scm-crypt-pathname)))))))
	 #t)				; We found the file.
	(t #f)))			; We didn't find the file.

;;; Since this runs only -after- the user supplies a passphrase, we have to return
;;; any status info as something that can be sent to the browser.  Fatal errors
;;; should really arrange for Yenta to exit, but we have to do that elsewhere.
;;; So we return a cons whose car is one of ok, mismatch, unknown-version, or
;;; version-spoof, and who cdr is an #f for the first two and an error string
;;; for the latter two.  (It might also return 'cant-happen and an error-string.)
;;; [We might also return (cons #f 'file-not-found) if the cryptfile ain't there.]
(define (vars:try-loading-encrypted)
  (format-debug 0 "~%vars:try-loading-encrypted.~&")
  (cond ((file-exists? (vars:vars-scm-crypt-pathname)) ; If it's not there, do without it---this must be the first time the user's run us.
	 (let ((result (vars:load-encrypted)))
	   (case (car result)
	     ((ok mismatch) result)	; Let the caller handle it.
	     ((unknown-version)		; Can't happen, theoretically, because vars:try-loading-browser-cert should have caught it first and erred.
	      (cons 'unknown-version
		    (format nil "~%~A, which holds Yenta's~&~
                            configuration information, claimed a version (~A) in its encrypted~&~
                            portion that is unrecognized.  But this should have been caught~&~
                            in the unencrypted envelope.  This is an internal error; please~&~
                            make a copy of ~2:*~A in case a maintainer needs to look at it,~&~
                            and report this bug.  If this used to work, you'll probably have~&~
                            to restore a backup copy of ~:*~A~*.  Sorry.~&"
			    (vars:vars-scm-crypt-pathname)
			    (cdr result))))
	     ((version-spoof)		; Complain, but let the user draw his own conclusions.  Don't induce panic by saying the word "attack".
	      (cons 'version-spoof
		    (format nil "~%~A, which holds Yenta's~&~
                            configuration information, claimed a version (~A) in its unencrypted~&~
                            portion that doesn't match the version (~A) claimed in its encrypted~&~
                            preamble.  Someone may have edited the file in an attempt to roll back~&~
                            to a previous version; this is not allowed.  If this used to work, you'll~&~
                            probably have to restore a backup copy of ~3:*~A~2*.  Sorry.~&"
			    (vars:vars-scm-crypt-pathname)
			    (cadr result)
			    (cddr result))))
	     (else
	      (cons 'cant-happen
		    "vars:try-loading-encrypted fall off its case; please report this internal error.")))))
	(t
	 (cons #f 'file-not-found))))

;;;; Debugging functions.

(define (vars:stream-copy-until-eof in out) ; Assumes it gets things we can call read on.
  (let ((form (read in)))		; This is safe if it gets called (a) for debugging, or (b) from -inside- the crypted envelope ...
    (unless (eof-object? form)		; ... ('cause presumably only we could have written the encrypted data).
      (write form out)
      (newline out)			; Just for human readability...
      (vars:stream-copy-until-eof in out))))

;;; Takes the on-disk, encrypted vars.scm.crypt and produces a decrypted vars.scm
;;; for examination.  Uses whatever *hashed-passphrase* is currently set.  Obviously,
;;; this is very dangerous and should not be called in production code, because it
;;; will leave all sorts of private data (like the user's private key) on disk.
;;;
;;; Returns whatever vars:load-encrypted-internal returns.  Note that, even if that
;;; fails, by then we'll presumably have bashed the output file.  Fixing this doesn't
;;; seem worth the effort.
(define (vars:dump-encrypted . where)	; Should be a filename (not a pathname).  Defaults to vars.scm.
  (let* ((name (if (and (pair? where)
			(string? (car where)))
		   (car where)
		   "vars.scm"))
	 (pathname (yenta-name name))
	 (old-success #f))
    ;; We have to make sure that *vars:successfully-loaded-everything* is #f, so vars:load-encrypted-internal
    ;; will actually call the work-fn.  But make sure we don't actually bash its value, no matter what happens.
    (dynamic-wind
     (lambda ()
       (set! old-success *vars:successfully-loaded-everything*)
       (set! *vars:successfully-loaded-everything* #f))
     (lambda ()
       (vars:load-encrypted-internal
	(lambda (in)
	  (let ((out (open-output-file pathname)))
	    (vars:stream-copy-until-eof in out)
	    (close-port out)))))
     (lambda ()
       (set! *vars:successfully-loaded-everything* old-success)))))

;;; End of file.
