;;;; Random definitions that don't go well anywhere else.

(yreq "Utilities/yenta-utils")

;;;; +++ Avoiding writing out unreadable objects (e.g., #<...>) when saving slashified data.
;;; I -think- this should go away once the C side can save its state correctly, but maybe not.
;;;
;;; We probably can't get rid of save-proc-false in newer Yentas if it might possibly be in
;;; a fielded customer's vars.scm file, since it's embedded in *vars:vars*.  Although maybe
;;; it's never noticed there again?  Dunno.)
(defmacro save-proc-false (-var-)
  `(lambda (ignored) `(define ,',-var- #f))) ; Tricky enough for ya?  ((save-proc-false *okay*) 3)  -->  (define *okay* #f).

;;; This is intended to be used for save-procs which actually save their state via files
;;; in the filesystem---not by returning a list to be incorporated into the vars file.
;;; This means, basically, C functions.
;;; %%%

;;;; +++ Crypto.

(def-yenta-var *identity:handles* (make-hash-table 128))

(def-yenta-var *interests:number-back* (make-hash-table 128))
; This table is interest-ID -> the person we heard about it from first
; This is where we look if someone says that we were the source for a followed
; rumor, and we didn't originate it. We look up in here, and pass the info
; back.

;;; ++ All of these variables are set by init-keys.
(def-yenta-var *local-yenta-priv-key* #f)
(def-yenta-var *local-yenta-pub-key* #f)
(def-yenta-var *local-yenta-cert* #f)
(def-yenta-var *local-yenta-id* #f)
(def-yenta-var *local-yenta-addr* #f)
(def-yenta-var *stats:id* #f)
(def-yenta-var *attest:signed-own-attestation?* #f)
;;; --
(def-yenta-var *hashed-passphrase* #f)	; #f is no passphrase, and is the state until one is set.

(define *ui:yid-printed-length* #f)	; The number of characters in the printed representation of a Yenta-ID.  Set by init-keys.

(define (generate-my-yid-attestation)
  (format nil "My public key's fingerprint is ~S" (local-binary-yid->user-rep)))

(define (init-keys)
  (cond ((not (and *local-yenta-pub-key* *local-yenta-id* *local-yenta-addr*
		   *httpd:cert* *stats:id* *stats:id-hex*
		   *attest:signed-own-attestation?* *local-yenta-cert*
		   *local-yenta-priv-key*))
	 ;; It is an error for one of these to be set while others are not.  Rather than sort it all out,
	 ;; just generate them all if we find even one of them missing.
	 (ssl:err-if-randbits-unavailable 
	  *ssl:initial-key-randbits*
	  ;; We couldn't get what we need, much less what we want---despite having asked for it just now in ssl:generate-random-state.
	  "We wanted ~S random bit~:P, but only had ~S available." *ssl:initial-key-randbits* (ssl:randbits-in-pool))
	 (cond ((not *ui:keyboard-available*)
		(logger:log-and-display 1 "We're initing keys, but we don't have a keyboard available!")
		;; No idea what to do here, so we might as well just fall through and generate the keys anyway.
		;; Entropy has already been established, so least we won't prompt for it, right?  Here's hoping...
		)
	       (t
		(format t "~%Yenta is now generating your keys.  You'll see four lines of . and +~&~
                             characters while it does this; it should take only a few moments.~2&")))
	 (ssl:eat-randbits! *ssl:initial-key-randbits*) ; Thank you our lord for these bits we are about to consume.
	 (let ((r (ssl:generate-rsa 1024 #t)))
	   (set! *local-yenta-priv-key* (ssl:rsa-private-key->der-string r))
	   (set! *local-yenta-pub-key* (ssl:rsa-public-key->der-string r))
	   (set! *local-yenta-id* (public-key->yenta-id *local-yenta-pub-key*))
	   (set! *local-yenta-cert* (ssl:make-cert
				     (string-append "InterYenta self-signed certificate for "
						    (ui:bytes->hex *local-yenta-id*))
				     r 0 (current-time) #t))
	   (ssl:free-rsa! r))
	 (format-debug 200 "~&randBits = ~S~&" (ssl:randbits-in-pool))
	 (set! *local-yenta-addr* (list
				   (local-host)
				   ""
				   *local-yenta-id*
				   *local-yenta-pub-key*))
	 ;; See also the call to identity:sign-addr in ui:registration-satisfactory?.
	 (identity:sign-addr)
	 ;; Generate the actual cert we give to the browser.
 (set! *httpd:cert*
	       (let* ((keys (ssl:generate-rsa 1024 #t))
		      (x (ssl:make-cert
			  (string-append "Yenta-"
					 (ui:bytes->hex *local-yenta-id*)
					 "-"
					 (date-string))
			  keys 3653 (current-time) #t)))
		 (set! *httpd:private-key* 
		       (ssl:rsa-private-key->der-string keys))
		 x))
	 (set! *stats:id* (ssl:random-data 8))
	 ;; We only use *stats:id-hex* when logging, (a) because we might as well only compute it once,
	 ;; but (b) more importantly, so things like the debugging server, the bootstrap server, and the
	 ;; stats receiver can (in the latter case, recursively) use the stats system to log unusual events,
	 ;; and they'll set it to a special value "by hand".
	 (set! *stats:id-hex* (ui:bytes->hex *stats:id*))
	 ;; Sign our own fingerprint, and set a variable used by the UI.
	 ;; For clarity, put quotes around it, and no trailing period, so users don't think the period is part of it.
	 (add-attestation! (generate-my-yid-attestation))
	 (set! *attest:signed-own-attestation?* #t)
	 ;; Save variables immediately, so a quit won't lose us the random bits and keys we just generated.
	 ;; ---Actually, -don't-!  Don't do this until we've asked the user for a passphrase, or the data
	 ;; we write to disk (which includes the user's private key) will be unprotected.  Sure, it'll have
	 ;; a session key, but that key will be hashed by a predictable (e.g., null) passphrase.  Instead,
	 ;; wait until the user has supplied a passphrase, and then save immediately thereafter.  Also,
	 ;; we'll save using vars:save-encrypted, not vars:save-vars.
;	 (vars:save-vars)
	 )))

;;;; +++ Interests.

(def-yenta-var *interests:last-collect* #f)
(def-yenta-var *interests:last-changed* #f) ; New clusters made interesting.
(def-yenta-var *interests:collect-freq* 0)
(def-yenta-var *interests:next-scan* 0)
(def-yenta-var *interests:search-dirs* '())

(def-yenta-param *interests:match-threshold* 0.25 
  "Interest matching threshold"
  "This determines how much a prospective match has to be similar to your own interest for me to decide that you share an interest."
  vars:->[0-1]
  (matching settable))

(def-yenta-param *interests:follow-threshold* 0.10
  "Interest partial match threshold"
  "This determines how close an interest has to be to a rumor in order for me to follow up on the rumor."
  vars:->[0-1]
  (matching settable))

(def-yenta-param *interyenta:accept-interest-threshold* .50
  "Accept interest threshold"
  "This determines how closely an interest sent to you has to be to one of your own interests in order for you to join it."
  vars:->[0-1]
  (matching settable))

;;; ++ All of these variables are set by init-interests.
(defvar *interface:provided-interest*  #f)
(defvar removed                        #f)
(def-yenta-var *messages:centroids*    #f (lambda (ignored)
					    (when *messages:centroids*
					      (compare:checkpoint-collection *messages:centroids*))
					    `(define *messages:centroids*
					       (compare:open-collection (yenta-name "centroids")))))
(def-yenta-var *interests:undone*      #f (lambda (ignored)
					    (when *interests:undone*
					      (compare:checkpoint-collection *interests:undone*))
					    `(define *interests:undone*
					       (compare:open-collection (yenta-name "undone")))))
(def-yenta-var *interests:database*    #f (lambda (ignored)
					    (when *interests:database*
					      (compare:checkpoint-database)) ; Doesn't take any args; knows which database implicitly.
					    `(define *interests:database*
					       (begin
						 (compare:open-database (yenta-name "interests/")) ; Doesn't return any useful value.
						 'the-data-base-is-now-open))))
(def-yenta-var *interests:information* #f)
;;; --

(define (init-interests)
  (set! *interface:provided-interest* (compare:temp-collection))
  (set! removed (compare:temp-collection))
  (or *messages:centroids*
      (set! *messages:centroids*
	    (compare:open-collection (yenta-name "centroids"))))
  (or *interests:undone*
      (set! *interests:undone*
	    (compare:open-collection (yenta-name "undone"))))
  (or *interests:database*		; This exists -only- to tell us whether the database is open yet.
      (set! *interests:database*
	    (begin
	      (compare:open-database (yenta-name "interests/"))	; Doesn't return any useful value.
	      'the-data-base-is-now-open))) ; Let us know, so we know whether to try to save it.
  (compare:initialize (string-append (getenv "HOME") "/.savantrc")) ; %%%
  (or *interests:information*
      (set! *interests:information*
	    (list-of (compare:index-limit)
		     (lambda ()
		       (vector ""
			       0
			       *interests:new-interests-are-interesting-by-default?*
			       "")))))
  )

(define (close-interests)
  (when *messages:centroids*
    (compare:close-collection *messages:centroids*))
  (when *interests:undone*
    (compare:close-collection *interests:undone*))
  (when *interests:database*
    (compare:close-database)))

;;;; +++ InterYenta.

(defvar *connections* '())
(def-yenta-var *iy:contact-list* '()) ; the people to talk to
(def-yenta-var *iy:to-do-lists* '()) ; the things to say to people
;;; NOTE: to-do-lists is what matters for determining whether we want to talk
;;; to someone; contact-list is just the list of people we're actually going
;;; to try to talk to. That is to say, if we give up on trying to find someone
;;; for the moment, that yid drops out of contact-list, but the to-do stuff
;;; stays in to-do-lists. This way we know what to say if they contact us
;;; (possibly from somewhere else).
(defvar *iy:in-progress* '()) ; not saved, for obvious reasons...

;;; ++ All of these variables are set by init-interyenta.
(def-yenta-var *iy:rumor-cache*    #f (lambda (ignored)
				       (when *iy:rumor-cache*
					 (compare:checkpoint-collection *iy:rumor-cache*))
				       `(define *iy:rumor-cache*
					  (compare:open-collection (yenta-name "rumor-cache")))))
(def-yenta-var *iy:rumor-info*   #f)
(def-yenta-var *iy:cluster-cache* #f)
;;; --

(define (init-interyenta)
  (iy:check-talking)			; See if we're sufficiently up to want to talk to people.
  (or *iy:rumor-cache*
      (set! *iy:rumor-cache*
	    (compare:open-collection (yenta-name "rumor-cache"))))
  (or *iy:rumor-info*			; Must be set -after- *iy:rumor-cache*!
      (set! *iy:rumor-info*
	    (list-of 
	     (compare:collection-length *iy:rumor-cache*)
	     (lambda ()
	       (list #f #f #f #f #f)))))
  (or *iy:cluster-cache*		; *local-yenta-id* must be set up -first-!  [E.g., after init-keys]
      (set! *iy:cluster-cache*
	    (list-of (compare:index-limit)
		     (lambda () 
		       (list *local-yenta-id*)))))
  )

(define (close-rumor-cache)
  (when *iy:rumor-cache*
    (compare:close-collection *iy:rumor-cache*)))

;;;; +++ UI.

(def-yenta-var *ui:config-new* #t)
(def-yenta-var *ui:interest-new* #f)
(def-yenta-var *ui:contact-new* #f)
(def-yenta-var *ui:request-new* #f)
(def-yenta-var *ui:param-new* #f)
(def-yenta-var *ui:news-new* #f)
(def-yenta-var *ui:messages-new* #f)
(def-yenta-var *ui:attestations-new* #f)

(def-yenta-var *ui:bookmarks-are-alphabetic* #t)

(def-yenta-var *ui:bookmarks-listing* '()) ; %%% This definition should maybe go into a different file, when we've implemented bookmarks.

(def-yenta-var *ui:news* '())

;;; %%% Note that nothing ever sets this now.  We should clean this up somehow.  It's still read
;;; %%% by ui:note-pic, but of course that clause of the cond can never be taken.
(def-yenta-var *ui:news-note* #t)	; do we do real-time news notification?

;;; Whether or not we can autobug.  Currently, the stat-server will autobug anyway,
;;; since it includes *scheduler:erring-taskinfo*, but we'll probably use this to
;;; identify the user or something (and if we do, then when the reg page says
;;; "Yenta will forget your email identity", that won't be quite true---but how
;;; to succintly explain that it'll only be used for autobug reports?).
(def-yenta-var *user:bug-report* #t)

;;; Whether or not to send the user's email address upon registration.  BUT obsolete!---cause
;;; this was intended for config.html/scm & config-resp, but we decided to do this only at
;;; registration-time, or at least not to remember across sessions that we've done it ('cause
;;; all we do is to send a one-shot).
(def-yenta-var *user:e-mail* #t)

(def-yenta-var *af:block-new* #f)
(def-yenta-var *af:regexp-new* #f)

(defvar *ui:news-seq-num* 0)		; For making sure only the right version of the form gets submitted.
(defvar *ui:send-seq-num* 0)		; Ditto-- make sure a message only gets sent once.
(defvar *af:block-seq-num* 0)

(defvar *af:regexp-seq-num* 0)

;;;; +++ Define some other stuff not defined elsewhere.
 
(define (maybe-create-yenta-directory)
  (define (checked-mkdir maybe-dir)
    (let ((dir (string-edit "/$" "" maybe-dir))) ; NetBSD mkdir doesn't work if the pathname ends with a slash.
      (unless (directory? dir)		; %%% Doesn't check that the permissions are correct.  Later...
	(unless (mkdir dir #o700)	; If we try to mkdir over a plain file, we'll just fail, which is safe.  We won't blow it away.
	  (error (format nil "Couldn't create directory ~A.~&~
                              Please make sure there is not already an ordinary file there,~&~
                              and that permissions of its parent allow us to create files there.~&~
                              Then try starting Yenta again."
			 dir))))))
  (checked-mkdir (yenta-name ""))
  (checked-mkdir (yenta-name "interests")))

;;; This is set by yenta-exit to inform tasks such as InterYenta that they should terminate gracefully.
;;; At some point in the future after this gets set (probably less than 60 seconds), scheduler:quit will
;;; be called by deferred-wait-for-no-pending-fetches-and-quit (via wait-for-no-pending-fetches-and-quit),
;;; and scheduler:quit will set *scheduler:quit-pending*.  Once -that- happens, this Yenta is doomed---the
;;; scheduler will bail after the current task finishes, and then the true SCM quit will be called without
;;; an error-catch wrapped around it, which will terminate the image.
(define *yenta-exit-pending* #f)	; Obviously this can never be a yenta-var!  (We'd never finish coming back up...)

(define (yenta-exit . con)
  (set! *yenta-exit-pending* #t)
  (when *wb:yenta-started-completely*	; If we haven't fully started up, then interests, iY, the logger, etc aren't inited.
    (boot:kill-udp-listener)		; Don't allow any more bootstrap/broadcast connections.
    (close-yenta-server)		; Don't allow any more incoming InterYenta connections.
    (inc! *ctr:shutdowns*)
    (stats:log-event ':shutdown)
    (stats:log-to-server)		; Tell the stats server that we're going down.
    (when *vars:successfully-loaded-everything* ; If we didn't finish loading our config data, ...
      (vars:save-encrypted))		; ... we -certainly- shouldn't overwrite any existing file!
    (close-interests)			; Closes the message-centroids and interest databases.
    (close-rumor-cache))		; Close the rumor-cache database.
  (unless (null? con)
    (write "HTTP/1.0 204 Done\r\n\r\n" (car con))
    (close-port (car con)))
  (deferred-wait-for-no-pending-fetches-and-quit))

(define (connection-scavenger)
  (scheduler:add-periodic-task! 
   "Connection scavenger" 2 10
   (lambda ()
     (let ((now (current-time)))
       (set! *connections*
	     (filter (lambda (con)
		       (cond ((not (vector-ref con 1))
			      #f)
			     ((> now (+ 60 (vector-ref con 0)))
			      ((vector-ref con 1))
			      (scheduler:kill-task! (vector-ref con 2))
			      #f)
			     (else #t)))
		     *connections*))))))

;;;; Releasing the tty once we're rolling.

;;; It's assumed that something else sets *ui:keyboard-available* to #f.

(define *background-after-startup* #t)	; Maybe make this some sort of yenta-param?

(define (maybe-background)		; You must have called ui:cache-URL-info first!
  (unless *wb:developer-world*
    (when *background-after-startup*
      (format t "You should see a shell prompt next.  Yenta is now running in the background.~&~
                 In most environments, it will continue running even after you log out.  This~&~
                 is intentional, and allows it to contact other Yentas even when you're not~&~
                 around.  Just point your browser at the original URL when you log back in.~2&~
                 Please aim your browser at ~A now.~2&"
	      (ui:url-only-string))
      (unless (zero? (fork))
	(exit)))))

;;; End of file.
