;;; There's some temporary weirdness with the logger reporting no clusters
;;; during reclustering. I'm not sure exactly what it should do in this
;;; situation, but probably it shouldn't log that particular information at
;;; the time.

;;; Adapted from the Yenta debugging logger, logger.scm
;;; This is logging client code, to be shipped with Yenta.

(require 'format)
(yreq "Scheduler/scheduler")
(yreq "Utilities/yenta-utils")

;;; Set by init-keys for normal Yentas, or by wb:load-core-infrastructure for
;;; use in the central servers (which have distinguished ID's, for debugging.)
(def-yenta-var *stats:id-hex* #f)

;;;; Lower-level functions.  What talks to the logging server.

;;; Note that *stats:id-hex* is defined in definitions.scm and set by init-keys in that file.
;;; It is also set by various central servers to distinguished values.

;;; Never make this variable a yenta-var.  Doing so would cause its value to be
;;; persistent, which means that a change caused by a new release would have to
;;; be explicitly undone by that release, or it would wind up using the old value.
;;; This isn't supposed to change while Yenta is running anyway, so there's no
;;; need for it to be a yvar.
(define *stats:port* 14997)

;;; Never make this variable a yenta-var.  Doing so would cause its value to be
;;; persistent, which means that changes to either the hostname (done in a newer
;;; release of Yenta) or the IP address (done via the DNS) would not be noticed.
;;; While it would be slightly more efficient to store the result of doing
;;; inet:string->address here as well, resist the temptation---doing so would
;;; mean that a long-running Yenta would not pick up a DNS change of the server
;;; address until the Yenta was restarted, would could theoretically be weeks.
(define *stats:host* "yenta-stats.media.mit.edu")

(define stats:report-logging-errors nil) ; Set this to T for debugging.  Note that logging errors still bump a counter even if they aren't displayed.

;;; This is one of two toplevel interfaces for clients to use the logger.
;;; Note that messages to be logged should not have leading or trailing
;;; newlines; we'll supply those as appropriate.  Returns (message . status),
;;; where message is the message that we logged or tried to log, even if we
;;; got an error actually doing the logging.  status is t if the log won,
;;; otherwise nil. 
(define (stats:log-result->message result) (car result))
(define (stats:log-result->status  result) (cdr result))
(define (stats:log message)
  (let ((out (socket:connect (make-stream-socket af_inet)
			     (inet:string->address *stats:host*)
			     *stats:port*)))
    (cond ((eq? out #f)
	   (when stats:report-logging-errors
	     (format t "~%Couldn't log this entry:  ~A~%" message))
	   (cons message nil))
	  (else
	   (format out "~A" message)
	   (close-output-port out)
	   (cons message t)))))	; Return the message even if we got a logging failure.

;;; This is the other toplevel interface; it both logs and displays to the standard output.
(define (stats:log-and-display mess-text)
  (let* ((results (apply stats:log mess-text))
	 (message (stats:log-result->message results))
	 (status  (stats:log-result->status  results)))
    (format t "~%~A~%" message)))

;;;; Actually sending things to the server.

;;; Utilities.

;;; Parameters and constants.
(def-yenta-param *stats:log-soon-timeout* 15 ; Log in 15 seconds.
  "How soon Yenta will log if told to log soon"
  (format nil "Tells Yenta how often to check whether it has been told to log 'soon.'~&~
               If *stats:log-soon?* is true when this timeout is reached, Yenta will set its~&~
               *stats:log-now?* flag.")
  vars:->nonneg-number
  (logger))

(def-yenta-param *stats:timeout* 3600	; An hour.
  "How often Yenta will log by default"
  (format nil "Tells Yenta how often to log if nothing has told it to log sooner.~&~
               When this timeout expires, sets the *stats:log-now?* flag.")
  vars:->nonneg-number
  (logger))

(defvar *stats:log-soon?* #f)
(defvar *stats:log-now?* #f)

;;; Builds the logstring we'll emit.  This is a little peculiar, because it
;;; might get called from server worlds; we check to see if *local-yenta-id*
;;; is reasonable, and assume it's a real Yenta if so.  If not, many things
;;; will be meaningless and are omitted to avoid a blowout.
(define (stats:build-logstring)
  (cond ((and (defined? *local-yenta-id*)
	      *local-yenta-id*)
	 (format nil "((:id ~S) ~
                       (:time ~S) ~
                       ((:counters ~S) (:settings ~S) (:events ~S) ~
                        (:interests ~S) (:clusters ~S) ~
                        (:conns ~S) (:attestations ~S) ))"
		 *stats:id-hex*
		 (current-time)
		 (vars:simple-param-list '(counter))
		 (vars:simple-param-list '(settable))
		 *stats:event-log*
		 (stats:get-interest-count)
		 (stats:get-clusters)
		 (stats:get-conn-count)
		 (stats:get-attestations)))
	(t
	 (format nil "((:id ~S) ~
                       (:time ~S) ~
                       ((:counters ~S) (:settings ~S) (:events ~S)))"
		 *stats:id-hex*
		 (current-time)
		 (vars:simple-param-list '(counter))
		 (vars:simple-param-list '(settable))
		 *stats:event-log*))))

;;; Log our current state to the server, if we can, and keep track of the result.
(define (stats:log-to-server)
  (let* ((plaintext (stats:build-logstring))
	 (logstring (stats:encrypt-to-server plaintext))
	 (result (stats:log logstring)))
    (cond ((stats:log-result->status result)   ; If log was successful ...
	   (set! *stats:event-log* '()))       ; ... clear event log.
	  (else                                ; Otherwise, a logging error occurred: ...
	   (inc! *ctr:logging-errors*))))      ; ... don't clear the log, and bump a counter instead.
  (inc! *ctr:log-count*)
  (set! *stats:log-now?* #f)
  (set! *stats:log-soon?* #f)
  ;; Reset log timeout.  Done this way, instead of using a periodic task, because otherwise changes
  ;; in the timeout (e.g., because the user changed it, or because we're trying to dynamically adjust
  ;; the logging interval based on advice from the server) won't be noticed without also knowing to
  ;; kill and restart the task.  While this would be easy enough for the latter case, the former would
  ;; require special-casing the UI.
  (scheduler:remove-task! *stats:timeout-taskname*)
  (scheduler:add-timeout-task!
    *stats:timeout-taskname* 3
    *stats:timeout*
    (lambda ()
      (set! *stats:log-now?* #t))))

;;;; Encrypting the logstring.

;;; Krsa is built into Yenta and cannot be changed.
(define *stats:server-public-key* "MIGJAoGBAONaKQd3lI/MdhdGZ7p2FAQwSUojRv8KRmbNZH2aRaf2cM/WjzG87xhKOeQZybTHOAiCfkdK4GD91ZNZuykupgZ+Puzn9AwUYB6o5zTwakg0k+KDxX/4FsR8m+mLuYalY4a1+JAajgyowSHv7UeUcKeioFcxjcPqgD4C34YYmBYhAgMBAAE=")

;;; Current version of the encrypted logstring format.
(define *stats:encryption-version* 1)

(define (stats:encrypt-session-key k)	; Encrypts K, using Krsa as the key, producing Kp.
  (let ((key (ssl:der-string->rsa-public-key (base64-decode *stats:server-public-key*))))
    (ssl:rsa-public-encrypt k key)))

;;; Encrypt the string to the stats receiver.  We generate a session key, K,
;;; encrypt the data with that (generating Dk), and then encrypt the session
;;; key with the server's public key, generating Krsa.  We then transmit a
;;; tuple of Krsa and Dk to the server.  When received (perhaps long after
;;; reception---that's up to the receiver), it regenerates K by decrypting
;;; Krsa with its private key, and then regenerates D by decrypting Dk with K.
;;;
;;; This routine emits a complete logstring that the server uses.  The string
;;; is very similar to that used in vars:save-encrypted:  it consists of a
;;; string holding a numeric version number, Krsa, and Dk.  Included in Dk
;;; is a VV verifier pair, so the server can tell that the right public key
;;; was used to encrypt K.
(define (stats:encrypt-to-server logstring)
  (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 (stats:encrypt-session-key k))
	 (results			; We'll reduce this list to a single string later.
	  (let* ((key (crypt:make-key k))
		 (ec (crypt:make-encrypt-context key)))
	    (let ((dk
		   (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.
			 (write logstring wcf)
			 (close-port wcf))))))
	      dk))))
    (format nil "~S~S~S"		; We want the double-quotes around each substring.
	    (number->string *stats:encryption-version*) ; This is repeated in the crypto envelope, to prevent weird version-rollback spoofs.
	    kp				; Save the encrypted session key, Kp.
	    results)))			; The actual encrypted data.

;;;; Scheduler tasks for actually getting the logging to happen.

;;; See also the end of stats:log-to-server.

(define *stats:timeout-taskname* "Stats logger: log timeout expired")
(define *stats:soon-taskname* "Stats logger: checking if I should log soon")
(define *stats:now-taskname* "Stats logger: checking if I should log now")

(define (stats:create-tasks)
  ;; Every *stats:log-soon-timeout* seconds, checks to see whether *stats:log-soon?* 
  ;; is set.  If it is, sets *stats:log-now?* and resets *stats:log-soon?*
  (scheduler:add-periodic-task! 
    *stats:soon-taskname* 3
    *stats:log-soon-timeout*
    (lambda () 
      (when *stats:log-soon?* 
	(set! *stats:log-now?* #t)
	(set! *stats:log-soon?* #f))))
  ;; Every *stats:timeout* seconds, sets *stats:log-now?* to true so that logging
  ;; will happen at least this often.  Happens just once; rescheduled when logging occurs.
  (scheduler:add-timeout-task! 
    *stats:timeout-taskname* 3
    *stats:timeout*
    (lambda () (set! *stats:log-now?* #t)))
  ;; If *stats:log-now?* is true, log to server now.  Triggered this way because
  ;; various processes can cause *stats:log-now?* to become true.
  (scheduler:add-task! 
    *stats:now-taskname* 3
    (lambda () *stats:log-now?*)
    stats:log-to-server)
  )

;;;; Logging when particular events take place.

;;; EVENTS
;;; startup
;;; shutdown
;;; contact-with-new-yenta
;;; contact-with-known-yenta
;;; exchange-of-cluster-info
;;; referral-initiated
;;; referral-granted
;;; cluster-entered
;;; cluster-left
;;; introduction-initiated
;;; introduction-granted
;;; introduction-refused
;;; attestation-created
;;; attestation-signed
;;; attestation-fetched
;;; attestation-destroyed
;;; misc

(def-yenta-var *stats:event-log* '())

(define (stats:log-event event)
  (let ((logstring (list (current-time) event)))
    (set! *stats:event-log* (cons logstring *stats:event-log*))
    (set! *stats:log-soon?* t)
    t))

;;;; Utilities used for stat logs.

(define (stats:get-interest-count)
  (list (list ':interest-count (length (compare:indices)))))

(define (stats:get-clusters)
  (let ((ret '()))
    (if *interests:clustering?*
	'()
	(for-each 
	 (lambda (index)
	   (if (vector-ref (list-ref *interests:information* index) 2) 
	       ;; Interest is relevant, cluster exists.
	       (let ((size 
		      (vector-ref 
		       (list-ref *interests:information* index) 1)))
		 ;; Size may be 0, but we'll still report the cluster.
		 (set! ret (cons size ret)))))
	 (compare:indices)))
    (list (list ':clusters ret))))

(define (stats:get-conn-count)
  (list (list ':conn-count (length *connections*))))

;;; This takes special handling.  If we don't explicitly filter out the att produced automatically (the self-signed YID one),
;;; then the stat-logger will know -everyone's- YID in its logs!  (And will also be accumulating a correspondence between
;;; stat ID's and YID's.)  So we cache this attestation the first time we need it here, for efficiency, and then strip it
;;; out of the ones we log.  Yucko, but...  Note that we can't cache it when it's first created (by init-keys calling
;;; generate-my-yid-attestation in definitions.scm), 'cause it won't be available after a restart.  I could make a redundant
;;; yvar and save it that way, but it seems like a lot of hassle for a marginal case.
(defvar *stats:local-yid-attestation* #f)
(define (stats:get-attestations)
  (unless *stats:local-yid-attestation*
    (set! *stats:local-yid-attestation* (generate-my-yid-attestation)))
  (let ((filtered-atts
	 (remove-if (lambda (att)
		      (let ((text (car att)))
			(string=? text *stats:local-yid-attestation*)))
		    (identity:get-attestations *local-yenta-id*))))
    (map (lambda (att)
	   (list (car att) (length (cadr att))))
	 filtered-atts)))

;;; End of file.
