;;; Simpleminded logger for Yenta processes.

;;; This assumes it's running standalone, not in the same process as some running Yenta.

(require 'posix-time)
(require 'format)
(require 'sort)

(yreq "Scheduler/scheduler")
(yreq "Utilities/yenta-utils")

;;;; Server side.

;;; Note:  It'd be nice to separate this out into its own file, so this doesn't
;;; get shipped with normal Yenta worlds.  That's a detail, for now, except for
;;; one bug:  we should define our own stub for boot:close-udp, which isn't defined
;;; in a dbg-log server world, and which causes (quit) [which calls yenta-exit] to
;;; blow out as it's quitting.  Obviously, this only matters if you're quitting a
;;; dbg-log-devo world, so this isn't too important.

;;; This shouldn't be necessary, but log entries are getting reordered due to queuing at the select() layer [I think].
(define (scheduler:null-job-task)
  (usleep 100000))			; Normal scheduling.

;;; 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 logger:port 14998)

;;; 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 logger:host "yenta-dbg.media.mit.edu")

(define logger:report-logging-errors #f); Set this to #t for debugging.  (Note that binding it with LET won't work---no dynamic binding in scheme!)
(define logger:log-levels-below 50)	; Anything with a logging level below this gets logged.
(define logger:fast-input-source-throttle 1000)

(defvar logger:pathname #f)		; Set by the real logging server, not in customer worlds.

;;; We have to keep track of open connections to compensate for an apparent bug in UNIX's network handling.
;;; If we don't defer successive rapid connections from the same host, we can wind up reordering the order
;;; of the incoming log requests.  This can make debugging quite a bit more challenging.
; (define logger:open-connections '())

;; It appears that open-io-file errs if the file doesn't already exist.
;; Hence, we attempt to create it if it doesn't already exist or isn't writable.
(define (logger:maybe-create-logfile)
  (unless (access logger:pathname "w")
    (let ((out (open-output-file logger:pathname)))
      (cond (out
	     (close-output-port out))
	    (else
	     (format-error "Couldn't create logfile ~A." logger:pathname))))))

;;; Disallow accepting more than one connection at a time from the
;;; same client.  This prevents a fast client logger from overrunning
;;; us with connections and hence trying to create two tasks with the
;;; same name.
(defvar logger:handling-connection nil)

(define (logger:initialize)
  (vars:load-vars)			; [This is okay---it's the logger calling this, not a user's Yenta.]
  (manage-persistent-yenta-versions)
  (logger:maybe-create-logfile)
  (let ((sock (socket:bind (make-stream-socket af_inet) logger:port)))
    (socket:listen sock 5)
    (scheduler:add-task!
     "Wait for log requests" 3
     (lambda ()
       (logger:incoming-connection? sock))
     (lambda ()
       (logger:receive sock)))
    (logger:log-pending)
    (scheduler:initialize!)))

; (define last-sock nil)		; %%% DEBUG.

(define (logger:incoming-connection? sock)
  (let ((selectable (socket:select sock)))
;  (cond (selectable
;	  (set! last-sock sock)
;	  (cond (logger:handling-connection
;		 (format t "~&Wanted to accept, but already handling a connection.~&") ; %%% DEBUG.
;		 (break)))))
   (let ((receive? (and selectable
			(not logger:handling-connection))))
     (when receive?			; Do this now, to eliminate any possibility of a timing window.
       (set! logger:handling-connection t)) ; %%% This should really use dynamic-wind to make sure it gets unset!
     receive?)))

;;; This apparently enforces mutual exclusion by virtue of closing the logfile after
;;; each request.  Should see if there's a way to do so with a continually-open logfile. --- %%%Don't need this anymore
(define (logger:receive sock)
  (let* ((connection (socket:accept sock))
	 (socket-name (getpeername connection))
	 (conn-id (inet:address->string (socket-name:address socket-name)))
	 (last-char-time (current-time))
	 (message-time last-char-time)
	 (parsing-flag 0)
	 (yenta-id "")
	 (seq-number "")
	 (message-text (sr:make-string 1000)))
    (define (timeout?) (> (- (current-time) last-char-time) 5))	; Timeout = 5 seconds.
    (let ((taskname (format nil "Writing log request from ~A" conn-id)))
      (scheduler:add-task!
	  taskname 2			; Writing this entry has the same priority as accepting later entries.
	  (lambda ()
	    (or (char-ready? connection)
		(timeout?)
		(socket:remote-end-closed? connection)))
	  (lambda ()
	    (let ((char nil))
	      (do ((i 0 (1+ i)))
		  ((or (not (char-ready? connection))
		       (> i logger:fast-input-source-throttle))	; We've read enough for this timeslice.
		   nil)
		(set! char (read-char connection))
		(set! last-char-time (current-time))
		(when (not (eof-object? char))
		  ;; Any message has to contain YID, #\Space, message sequence number, #\Space, and the text of the message.
		  ;; Parsing-flag is 0, 1 or 2 when the logger is reading, correspondingly, YID, message sequence number, or
		  ;; the text.
		  (if (and (eq? char #\space) (< parsing-flag 2))
		      (inc! parsing-flag)
		      (case parsing-flag
			((0) (set! yenta-id (format nil "~a~a" yenta-id char)))
			((1) (set! seq-number (format nil "~a~a" seq-number char)))
			(else
			 (sr:add-char! char message-text))))))
	      ;; Okay, we don't want to read anymore, so let's see if we need to return to this connection.
;	      (format t "read ~A  ~A ~A~%" yenta-id seq-number (sr:to-string message-text))
	      (cond ((or (eof-object? char)
			 (socket:remote-end-closed? connection)
			 (timeout?))
		     (logger:handle-message
		      yenta-id
		      (string->number seq-number) 
		      message-time
		      conn-id
		      (format nil "~:[~;[###Connection was timed out.###]  ~]~A"
			      (timeout?)
			      (sr:to-string message-text)))
		     (scheduler:remove-task! taskname)
		     (set! logger:handling-connection nil))
		    (t nil))))))))	; We will return to read from this connection.

(define (logger:handle-message yenta-id seq-num mess-time conn-id mess-text)
  (if (or (eq? "" mess-text)
	  (not (number? seq-num)))
      (logger:write-message mess-time 
       (format nil "~A Could not parse: ~A ~A ~A"
	       conn-id yenta-id seq-num mess-text))
      (let ((hi-entry (logger:entry-for-id yenta-id logger:highest-entries)))
	(cond ((and (not hi-entry) (= 1 seq-num)) ; New Yenta.
	       (logger:write-message mess-time
		(format nil "~A ~A ~A ~A"
			conn-id yenta-id seq-num mess-text))
	       (logger:add-highest! (list yenta-id seq-num)))
	      ((not hi-entry)		; We have never heard from this Yenta before, but it's not its first message.
	       (logger:add-highest! (list yenta-id 0))
	       (logger:add-pending! (list yenta-id seq-num mess-time conn-id mess-text)))
	      ((= (1- seq-num) (entry-seq-number hi-entry)) ; We got messages in order.
	       (logger:write-message mess-time
		(format nil "~A ~A ~A ~A" conn-id yenta-id seq-num mess-text))
	       (logger:change-entry! hi-entry (list seq-num)))
	      (else
	       (logger:add-pending! (list yenta-id seq-num mess-time conn-id mess-text)))))))

;;; If the message to be logged has the right format, this forges mail to majordomo
;;; asking to sign the user up for a mailing list.  Majordomo will send confirming
;;; mail before really signing them up.  Note that this calls out to a perl script,
;;; which itself calls sendmail, to actually send the message; this is totally gross,
;;; but it's simple.  It should be fixed at some point to just open a network connection
;;; directly to majordomo and speak SMTP at it.  This entire routine is an un-error-checked
;;; crock that should be done right someday.
(define logger:autoreg-script "./register.pl") ; This makes assumptions about pwd for the logging server, and what's in that dir.  Oh well...
(define (logger:autoreg message)
; (format-debug 0 "~&Checking message ~S~&" message)
  (let ((pos (regmatch ".+[0-9] SUBSCRIBE " message))) ; %%% At the moment, this just assumes it must be right.  Should error-check.
    (when pos
      (let ((status (system (format nil "~A ~A"	; %%% Something should probably check the status of this, but for the moment, we don't.
				    logger:autoreg-script
				    (substring message pos (string-length message))))))
;	(format-debug 0 "~&Status was ~S.~&" status)
	status))))

;;; Logs a message.
(define (logger:write-message mess-time message)
   (logger:maybe-create-logfile)		; If somebody's renamed the log out from under us, just create a new one.
   (let ((logport (open-io-file logger:pathname)))
     (cond ((eqv? logport #f)
	    (format-error "Can't open the log file!"))
	   (else
	    (let ((filesize (vector-ref (stat logport) 7)))
	      (when (> filesize 0)
		(file-set-position logport filesize)))
	    (format logport "~A ~A~%" 
		    (date-string mess-time)
		    message)
	    (close-io-port logport)
	    (logger:autoreg message)))))

;;;; Server side:  Getting all the entries in order.

;;; %%% TO DO:  Should handle the case of this server just coming up.
;;; The problem here is that -every- Yenta to log to us after we come
;;; up is going to have its entries delayed by our timeout, since we
;;; expect that we should have seen other entries first.  And -no- Yenta
;;; that's ever logged before this run will have a low-enough sequence
;;; number, since it's persistent for them---but -not- for us...  *sigh*
;;; Should probably maintain a table that says we've heard of the remote
;;; Yenta at -all- in this run, and just assume that the first thing we
;;; hear from them -must- be right if we've just come up...
;;;
;;; %%% Also, we should -really- be using a hash table below, not a list...

(defvar logger:highest-entries '())	; Table of highest logged messages for each Yenta.
(defvar logger:pending '())		; Table of pending messages.

(define (logger:add-highest! entry)
  (set! logger:highest-entries (cons entry logger:highest-entries)))

(define (logger:add-pending! entry)
  (set! logger:pending (cons entry logger:pending)))

(define logger:entry-for-id assoc)

(define (logger:change-entry! entry new-info-for-id)
  (set-cdr! entry new-info-for-id))

;;; Selectors.
(define entry-yenta-id car)
(define entry-seq-number cadr)
(define entry-time caddr)
(define entry-conn-id cadddr)
(define (entry-text entry) (nth 4 entry))
(define first car)
(define rest cdr)
(define add cons)

;gets all entries
;(define (logger:entries-for-id table id)
;  (let ((entries '())
;	(first car)
;	(rest cdr)
;	(add cons))
;    (do ((table table (rest table))
;	 (entries '() (if (eq? id (entry-id (first table)))
;			  (add (first table) entries)
;			  entries)))
;	((null? table) entries))))

(define logger:period 10)		; Run every 10 seconds.

;;; The following procedure sorts all entries in logger:pending, and
;;; then inserts each of them in the logger with the appropriate
;;; comment where required, unless the entry was recently added to the
;;; table and the preceeding message is missing.
(define (logger:log-pending)
  (scheduler:add-periodic-task!
    "Sort and log pending entries"
    3
    logger:period                           
    (lambda ()
      (let loop ((sorted (sort logger:pending
			       (lambda (x y)
				 (< (entry-seq-number x)
				    (entry-seq-number y)))))
		 (to-stay '()))
;       (pretty-print sorted)
;       (pretty-print to-stay)
	(if (null? sorted)
	    (set! logger:pending to-stay)
	    (let* ((entry (first sorted))
		   (id (entry-yenta-id entry))
		   (seq-num (entry-seq-number entry))
		   (hi-entry (logger:entry-for-id id logger:highest-entries))
		   (hi-seq-num (entry-seq-number hi-entry))
		   (diff (- seq-num hi-seq-num)))
	      (cond ((and (>= diff 2)
			  (< (- (current-time) (entry-time entry)) (* 3 logger:period)))
		     (loop (remove-if (lambda (i) (string=? id (entry-yenta-id i))) sorted)
			   (append! (remove-if-not (lambda (i) (string=? id (entry-yenta-id i))) sorted) to-stay)))
		    (t
		     (cond ((>= diff 2)
			    (logger:write-message (current-time)
						  (format nil "Message~P ~:[from ~D to ~;~*~]~D from Yenta ~A never arrived."
							  (1- diff) (= diff 2) (+ hi-seq-num 1) (- seq-num 1) id)))
			   ((<= diff 0)
			    (logger:write-message (current-time)
						  (format nil "The following message from ~A ~:[~;arrived late or ~]has ~
                                                               the same sequence number as one of the previous messages:"
							  id (< 0 diff)))))
		     (if (> diff 0)
			 (logger:change-entry! hi-entry (list seq-num)))
		     (logger:write-message (entry-time entry) 
					   (format nil "~A ~A ~A ~A" 
						   (entry-conn-id entry)
						   id
						   seq-num
						   (entry-text entry)))
		     (loop (rest sorted) to-stay)))))))))

;;;; Client side.

;;; 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, and nil if the desired message was a
;;; too low a priority (too high a level).  status is t if the log won, otherwise nil.
;;; If we're at too low a level, we return (t . t)---note that that final t really tells us
;;; nothing about the logger, since we dunno if it's even up, 'cause we didn't try it.
(define (logger:log-result->message result) (car result))
(define (logger:log-result->status  result) (cdr result))

(def-yenta-var *logger:log-count* 0)	; Saved across boots so the logger doesn't complain.

(define (logger:log level format-string . format-args)
  (cond ((< level logger:log-levels-below)
	 (let* ((message-text (apply format nil format-string format-args))
		(message (format nil "~A ~A ~2D ~A"
				 ;; We're not using the YID, for two reasons: (a) it's a privacy violation for the user's
				 ;; Yenta to unexpectedly log something with it, since you can't turn it off (although we
				 ;; expect that fielded Yenta's won't be logging things to the debugging server -anyway-),
				 ;; and (b) we -are- using it for the central servers, for things like an erring scheduler
				 ;; task, and it's nice to have their distinguished ID's show up in the logs.  Note,
				 ;; however, that if we have -no- SID, we'll use the IP address---this should never happen
				 ;; except with uninitialized Yentas trying to report errors, and figuring out which one that
				 ;; was is useful during testing.  Maybe in the future I'll take this out.
				 (or *stats:id-hex* (local-host))
				 (inc! *logger:log-count*)
				 level
				 message-text)) ; Include yenta's id, message sequence # and the logging level in the message.
		(out (socket:connect (make-stream-socket af_inet)
				     (inet:string->address logger:host)
				     logger:port)))
	   (cond ((eq? out #f)
		  (when logger: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, but not if at too high a log-level.
	(else
	 (cons nil t))))		; Too low a level.

;;; Logs -without- *stats:id-hex* set!  This forces the IP address to be used.
;;; Why is this important?  'Cause otherwise, when a user autoregisters for a
;;; mailing list the very first time his Yenta starts, we'd capture his email
;;; address -and- his stats-id!  This would break our promise of blinding the
;;; data, since comparison between the two logs could then be used to identify
;;; which email address is the source of any particular set of stats.  Yuck!
;;; Using the IP address (actually, this is often the FQDN of the host) is fine,
;;; 'cause log entries get this -anyway- already...
;;;
;;; Note that using this guarantees that the first -real- debugging entry will
;;; appear out of sequence, because we'll have incremented our internal sequence
;;; number (and sent w/an ID of our IP address), but the -server- can't know that:
;;; a later log with logger:log will of course seem to have missed an entry somewhere.
;;; Let's face it---the whole dbg-log sequence-number logic needs to be rethought.
;;; Fortunately, it's very rarely used; if there were no bugs, it would be -never-,
;;; except for autoreg.
(define (logger:log-with-ip level format-string . format-args)
  (let ((old-id #f)
	(results #f))
    (dynamic-wind			; Make damned sure the ID gets reset no matter what.
     (lambda ()
       (set! old-id *stats:id-hex*)
       (set! *stats:id-hex* #f))
     (lambda ()
       (set! results (apply logger:log level format-string format-args)))
     (lambda ()
       (set! *stats:id-hex* old-id)))
    results))

;;; This is the other toplevel interface; it both logs and displays to the standard output.
(define (logger:log-and-display level format-string . format-args)
  (let* ((results (apply logger:log level format-string format-args))
	 (message (logger:log-result->message results))
	 (status  (logger:log-result->status  results)))
    (when (not (eq? message #f))	; We were at a low enough log-level for the message to be emitted.
      (format t "~%~A~%" message))))
	
;;; End of file.
