;;;; Build the Yenta base world, and other worlds.

;;; This file loads everything we'll need in order to dump out a
;;; fully-loaded version of Yenta.  It does -not- start it!  If
;;; you want a started image, you should either call dump-yenta
;;; and then run the resulting image, or call start-yenta-browser
;;; to run the undumped copy.
;;;
;;; This file also contains support for dumping various other
;;; Yenta world-loads that are used only for support of customer
;;; Yentas.  This includes the debugging logger, the bootstrap
;;; server, and the statistics collector.
;;;
;;; NOTHING IN THIS FILE MAY DO ANYTHING THAT IS USER-SPECIFIC.
;;; This file exists solely to -load- code.  Nothing must run
;;; that might be different for different users, on different
;;; architectures, etc---this exists to build the binary ONLY.
;;;
;;; This file contains pretty nearly only things which are designed
;;; to either start Yenta or build the base world.  In particular,
;;; random definitions should go into definitions.scm, including
;;; definitions having to do with shutting Yenta down, etc.

;;; The name of this file is an old inside joke from Symbolics.
;;; The way the entire Lisp Machine operating system is shipped
;;; is as a "world load", essentially a snapshot of a virtual
;;; memory image.  This is conceptually similar to the unexec
;;; dumped form of SCM or of GNU Emacs.  It was called a world
;;; because it basically defined the entire world seen by the
;;; machine and hence by the user.
;;;
;;; The people who made these worlds, either for in-house use
;;; or for shipment to customers, were the "world workers";
;;; they were actually called the "Wobblies", which was the
;;; nickname given to the organizers of the turn-of-the-century
;;; labor movement called the International Workers of the World,
;;; or the IWW.  Hence, at Symbolics, wobblies made worlds, and
;;; the process of doing so was called wobbling.
;;;
;;; So.  Now you know.  Aren't you glad?

;;;; How to load anything at all.

;;; Make something like "require" that works no matter what
;;; directory we've started in.  This assumes that you have
;;; an environment variable defined called SCM_YENTA, which
;;; points to the very top of the Yenta source tree (e.g.,
;;; something that ends in "Yenta" [with no trailing slash!]).
;;; This is several levels above where the majority of the
;;; Yenta-application scheme code hangs out, but that means
;;; it also covers the directories holding the statistics
;;; collector and so forth.
;;;
;;; This also defines yreq, which is like req, but starts from
;;; the assumption that we're requiring something in the normal
;;; App part of the tree (e.g., not the statistics collector),
;;; hence we can default part of the pathname.  This must be
;;; changed if we ever rework the layout, but then again,
;;; so will half of the requires, probably...

(require 'format)

;;; Macros from yenta-utils, which we won't have loaded yet.
(defmacro wb:when (condition . actions)
  `(cond (,condition ,@actions)))
(defmacro wb:unless (condition . actions)
  `(cond ((not ,condition) ,@actions)))
(defmacro wb:push! (item some-list)
  `(begin
     (set! ,some-list (cons ,item ,some-list))
     ,some-list))			; Return the new list, for convenience.

;;; ++
;;; These variables require knowledge of the repository layout
;;; and the names of individual files.  They must stay in sync.
(defvar *yreq:default-base-env-var* "SCM_YENTA") ; /foo/bar/baz, e.g., -starts- with a slash, but does -not- end with one.
(defvar *yreq:default-base* "../../Scheme/Yenta/") ; This must end with a slash.
(defvar *yreq:default-file* "Utilities/wobbling.scm")
(defvar *yreq:default-top* "../../../")	; How far above *yreq:default-base* we need to go to get to "Yenta".
;;; --

(defvar *yreq:load-base* #f)		; Set to the true base, once we've figured it out.  Ends with a slash!

(defvar *yreq:loaded-files* '())
(defvar *yreq:req-depth* 0)

(define (yreq:load-base)		; Caches the correct base, or errs if it can't figure it out.
  (or *yreq:load-base*
      (let* ((probe-base (in-vicinity (implementation-vicinity)
				      (string-append *yreq:default-base*)))
	     (probe (string-append probe-base *yreq:default-file*))
	     (base? (file-exists? probe))) ; Simpleminded; if it's not the right file or a normal file at all, you lose.
	(if base?
	    (set! *yreq:load-base* probe-base)
	    (if (getenv *yreq:default-base-env-var*)	; Assumes it does -not- end with a slash!
		(set! *yreq:load-base* (getenv *yreq:default-base-env-var*))
		(error (format nil "Can't find ~A,~&and ~A isn't set!"
			       probe *yreq:default-base-env-var*))))
	(format t "~2&---> Code base is ~A < ---~2&" ; Don't make the developer guess about this...
		*yreq:load-base*)
	*yreq:load-base*)))

(define (yreq:make-yreq-pathname what)
  (string-append (yreq:load-base) what))

(define (yreq:make-req-pathname what)
  (yreq:make-yreq-pathname (string-append *yreq:default-top* what)))

(defvar *wb:last-page-load-time* 0)	; Last time we tried to load UI pages.

;;; This makes an effort to load updated pages, but you can't trust it absolutely,
;;; since there's no guarantee that an incremental reload will even try to load a
;;; page that somehow includes the updated one.  If that's the case, then we'll
;;; miss the update.  Any solution would require keeping an explicitly dependency
;;; graph around, which is way overkill.
(define (yreq:work what y? ignore-cache?) ; ignore-cache? is useful when yreq is called interactively, during debugging.
  (wb:unless (regmatch? "\\.scm$" what)	; Supply the .scm automatically, if required.
    (set! what (string-append what ".scm")))
  (let* ((path (if y?
		   (yreq:make-yreq-pathname what)
		   (yreq:make-req-pathname what)))
	 (updated?
	  (and (not (zero? *wb:last-page-load-time*)) ; This is an abuse of the UI page-preloading mechanism, but it's safer to notice...
	       (> (vector-ref (stat path) 10) *wb:last-page-load-time*))))
    (set! *yreq:req-depth* (1+ *yreq:req-depth*))
    (format t "~&+ ~A~A~:[~;Y~]REQ ~A"
	    *yreq:req-depth*
	    (make-string *yreq:req-depth* #\Space)
	    y?
	    what)
    (cond ((and (not ignore-cache?)
		(member path *yreq:loaded-files*)
		(not updated?))
	   (format t " [Cached]"))
	  (t
	   (wb:when updated?
	     (format t " [Updated]"))
	   (wb:when (not (try-load path))
	     (error "~&Couldn't load ~A.~&"))	; Use try-load so we don't get all the verbiage that load prints if verbose > 1.
	   (format t " [Done]")
	   (wb:push! path *yreq:loaded-files*)))
    (set! *yreq:req-depth* (1- *yreq:req-depth*))))

(define (req what . ignore-cache?)	; Used to wobble the statistics collector, at least.
  (yreq:work what #f (pair? ignore-cache?)))

(define (yreq what . ignore-cache?)
  (yreq:work what #t (pair? ignore-cache?)))

;;;; +++ Yenta version.

(yreq "Parameters/persistence")		; We need def-yenta-var from it.

;;; These variables have to be defined here, because the servers use them when
;;; logging errors via the stats logger.

;;; 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.
;;;
;;; Note that SCM 5c3 maps to (5 3 3), etc.  So far, nothing depends on these
;;; being numeric, but it seems safer not to be inconsistent...
(define *yenta-component-versions*	; Also used in issuing pings as well as in more obvious places.
  '((yenta 0 7 0) (scm 5 3 3) (ssl 0 8 1) (savant 1 3 8)))

(define (yenta-version)
  (cdr (assq 'yenta *yenta-component-versions*)))

(define (ui:yenta-version)		; %%% There's probably a better place for this.
  (let ((v (yenta-version)))
    (format nil "version ~A.~A.~A" (nth 0 v) (nth 1 v) (nth 2 v))))

(define (ui:yenta-uname)		; %%% There's probably a better place for this.
  (let ((u (uname)))
    (format nil "~A-~A.~A-~A"
	    (vector-ref u 0)		; OS name.
	    (vector-ref u 2)		; OS release version.
	    (vector-ref u 3)		; OS release version system level.
	    (vector-ref u 4))))		; Hardware.

;;; This is a yenta-ver specifically so we can figure out what version of Yenta wrote this saved state.
;;; At the moment, we merely save it and updated it from the version in the dumped image, but in the future,
;;; we might use this to implement some sort of backward-compatible, otherwise incompatible change.
(def-yenta-var *persistent-yenta-component-versions* #f) ; Set by manage-persistent-yenta-versions.

;;; This routine will presumably be changed by later Yentas, if they need to do somthing
;;; incompatible with the saved state.
(define (manage-persistent-yenta-versions)
  ;; For the moment, just set it unconditionally, without checking the old version.
  (set! *persistent-yenta-component-versions* *yenta-component-versions*))

;;;; Generic support for dumping any world.

;;; Generic stuff is in the wb: package, for "wobbly".

(define (wb:blanks-to-dashes! s)
  (let ((len (string-length s)))
    (do ((i 0 (1+ i)))
	((= i len) s)
      (wb:when (char=? (string-ref s i) #\Space)
	(string-set! s i #\-)))))

;;; +++ Stolen from yenta-utils, just in case we have a load that doesn't want to load that file.
;;;     [If I need much more from there, I may split it and load a piece here...]
;;;     [Hmm...  at this point, -every- world must load yenta-utils, 'cept the stats reformatter.
;;;      Maybe just give in to it?]
(require 'posix-time)			; So we get ctime.
(define (wb:date-string . when)
  (let ((timestr (ctime (if (null? when)
			    (current-time)
			    (car when)))))
    (substring timestr 0 (- (string-length timestr) 1))))

(define wb:dirmask (string->number "40000" 8))
(define (wb:directory? file)
  (and (file-exists? file)
       (= wb:dirmask
	  (logand wb:dirmask
		  (vector-ref (stat file) 2)))))
;;; ---

;;; Some useful utilities.
;;; ++ Pre-dump.
(define (wb:load-and-set-developer-world)
  (yreq "Utilities/yenta-utils")	; Otherwise, format-debug-level isn't even defined...
  (yreq "Scheduler/srepl")		; Otherwise, we might not have an srepl to start...
  (yreq "Logging/logger")		; For logger:report-logging-errors.
  (set! *wb:developer-world* #t)
  (set! logger:report-logging-errors #t)
  (set! format-debug-level 100))	; Show everything.

(define (wb:maybe-load-devo devo?)
  (cond (devo?
	 (wb:load-and-set-developer-world))))
;;; --
;;; ++ Post-dump.
(define (wb:maybe-run-devo)		; The post-dump side of things.
  (wb:when *wb:developer-world*
    (srepl:start)))			; srepl.  Assumes something else loaded the scheduler!
;;; --

;;; When the actual dumps happened.  This is handy for things like
;;; bug report heralds.  This variable is -not- a yenta-var, because
;;; its value is a function of the binary, not the user's saved state.
(defvar *wb:dump-times* '())		; Must -not- get reset if we reload this file!
;;; This is a developer world.  Done as a global variable to make it
;;; easier to pass as the thunk to dump (continuations can't be saved).
(define *wb:developer-world* #f)	; %%% Neither define nor defvar is really right here...

(define (one-persona-per-host? flag)
  (and flag (number? flag) (positive? flag)))

(define (load-pages-only? flag)
  (and flag (number? flag) (negative? flag)))

;;; Arranges to create a dumped world.  If PATH is not absolute, then
;;; it will be relative to the current working director.  DEVO? is a
;;; convenience arg that will be handed as the first arg to the
;;; procedure named by LOADER, in case it wants to arrange to do
;;; something special in debugging worlds; it is also used to modify
;;; the pathname of the dumped image.  TOPLEVEL is the new toplevel
;;; procedure that should run when the dumped image starts.
;;; LOADER-ARGS, if supplied, are additional args that are supplied to
;;; the loader if it needs them.
(define (wb:dump path devo? toplevel loader . loader-args)
  (force-output (current-output-port))	; Get any other messages out of the way -before- we rebind the output ports...
  (let ((executable (if devo?
			(cond ((one-persona-per-host? devo?)
			       (string-append path "-devo-persona"))
			      ((load-pages-only? devo?)
			       (string-append path "-pages-only"))
			      (t
			       (string-append path "-devo")))
			path))
	;; An intermediate dump is one that we expect to have other things loaded into, and then be dumped again.
	;; As such, it should notice command-line args when run, and should force *yreq:load-base* to be recomputed.
	(intermediate-dump (load-pages-only? devo?)))
    (set-current-output-port (current-error-port)) ; Required to keep a statically-linked Linux dump from segv upon first write to stdout; don't ask.
    (wb:when (and (file-exists? executable) (wb:directory? executable))
      (error (format nil "~A is a directory; cannot dump to it." executable)))
    (apply loader devo? loader-args)	; Actually configure this world.
    (cond ((file-exists? executable)	; Now that we haven't blown out in the loader, push any existing executable aside.
	   (let* ((timestamp (wb:date-string (vector-ref (stat executable) 9)))
		  (munged (wb:blanks-to-dashes! timestamp))
		  (final (format nil "OLD-~A.~A" executable munged)))
	     (format t "~&Renaming ~A to ~A...~&" executable final)
	     (rename-file executable final)))) ; This isn't gonna work so well if executable is absolute; the rename will wind up in cwd.  Fix?
    (wb:push! (current-time) *wb:dump-times*) ; Record when this dump was made.
    (if intermediate-dump
	(set! *yreq:load-base* #f)	; Force recomputation.
	(dump:bypass-normal-startup #t)); Requires the bypass-normal-startup patches to scm.c.
    (or (execpath)
	(let ((ep (in-vicinity (implementation-vicinity) "scm"))) ; Make a good guess if we can't figure it out...
	  (format t "~&Didn't know (execpath), so setting it to ~A...~&" ep)
	  (execpath ep)))
    (format t "~%Dumping to ~A...~&" executable)
    ;; [The kbflush didn't help.  Feh.]
;   (ssl:kbflush)			; Get rid of a "(quit)" from the build aliases.  Defined in ssleay-linkage.c.
    (force-output (current-output-port)); Must do this or the dumped image will say it again when it starts.  (Or would, if this was still stdout.)
    (dump executable toplevel)))	; Nothing after this call will be evaluated.

;;; Like wb:dump, but wraps some stereotyped stuff around the load & toplevel.
;;; This is -not- used by normal Yenta dumps, but instead by all the support programs.
(define (wb:dump-stereotyped path flags toplevel loader . loader-args)
  ;; This exists because often TOPLEVEL isn't defined under LOADER runs; this makes it impossible to easily specify TOPLEVEL.
  ;; Hence, this allows you to say 'TOPLEVEL instead in the call, and get it properly evaluated here.  Obviously, this only
  ;; works if TOPLEVEL is defined at toplevel by LOADER, but it damned well better be anyway!
  (define (make-fn thing)
    (if (symbol? thing)
	(eval thing)
	thing))
  (let ((devo? (and (pair? flags) (car flags))))
    (define (wrapped-loader devo?)
      (apply (make-fn loader) loader-args) ; make-fn just in case...
      ;; Apply this -after- the load, in case the load defines variables we want to change!
      ;; If the actual code needs to know -while loading- that this is a devo world, then it's probably written wrong...
      (wb:maybe-load-devo devo?))
    (define (wrapped-toplevel)
      (wb:maybe-run-devo)		; It is assumed, if we're starting an srepl, that TOPLEVEL will call scheduler:initialize!
      (apply (make-fn toplevel) '()))	; make-fn pretty definitely needed here in most cases.
    (wb:dump path devo? wrapped-toplevel wrapped-loader)))

;;;; Producing the normal Yenta binary.

;;; %%% Does the order of any of this stuff matter?
(define (wb:load-yenta-internal only-pages?) ; If only-pages? isn't #f, we'll only load enough to get the UI pages loaded, and that's it.
  (yreq "UI/preloading-pages")		; Figure out how to preload pages.
  (wb:unless only-pages?
    (require 'random)
    (require 'hash-table)
    (yreq "Scheduler/scheduler")	; The scheduler itself.
;   (yreq "Parameters/persistence")	; Persistent yenta variables.
    (yreq "Parameters/encryption")	; Encrypted persistent variables.
    (yreq "Scheduler/srepl")		; Scheduler read-eval-print loop.
    (yreq "Logging/counters")		; Defines all counters.
    (yreq "Logging/log-client")		; Sets up the statistics logging client.
    (yreq "Logging/logger")		; Sets up the debugging logging client.
;   (yreq "UI/scheme-to-html")
    (yreq "Interests/accessors")
    (yreq "Affordances/attestations")
    (yreq "Affordances/messages")
;   (yreq "Affordances/identity")
;   (yreq "Interests/find-documents")
    (yreq "Interests/compute-interests")
    (yreq "Interests/create-savantrc")
    (yreq "InterYenta/protocol")	; Load the inter-yenta server and procedures
    (yreq "UI/alerts")			; Define various alerts.
    (yreq "UI/httpd")			; Load the http server.
    (yreq "InterYenta/finding-other-yentas")
    (yreq "Utilities/definitions")
    (yreq "UI/start-ui")		; Load the UI and start.
    )
  (newline))				; yreq leaves us at the end of the previous line, so be clean.

;;; This is now obsolete, since Yenta now uses a two-phase startup.
;;; It's preserved for historical value; I might have missed something.
; (define (wb:start-yenta . yenta-name-override)
;   (when (and (pair? yenta-name-override)
; 	     (string? (car yenta-name-override)))
;     (set! *yenta-name-override* (car yenta-name-override)))
;   ;; Reload persistent state.
;   (maybe-create-yenta-directory)	; wobbling [here]
;   (interests:maybe-create-savantrc)	; create-savantrc
;   (vars:load-vars)			; persistence
;   (manage-persistent-yenta-versions)	; wobbling [here]
;   ;; Initialize interests.
;   (init-interests)			; definitions
; ; (scan-setup)				; find-documents
;   ;; Initialize crypto.
;   (ssl:initialize!)			; We need this to be initialized so we can bring up an SSL connection, -and- so we can generate random state.
;   (ssl:generate-random-state)		; ssl
;   (init-keys)				; definitions
;   (ssl:initialize-pool-tasks!)		; ssl
;   ;; Initialize statistics.
;   (ctr:count-minutes)			; counters
;   (stats:create-tasks)			; log-client
;   (inc! *ctr:startups*)			; counters
;   (stats:log-event ':startup)		; log-client
;   ;; Initialize networking.
;   (init-interyenta)			; definitions [must happen -after- init-keys!]
;   (connection-scavenger)		; wobbling [here]
;   (start-yenta-server)			; protocol
;   (iy:create-outgoing-yenta-task)	; protocol
;   (ui:compute-available-httpd-port)	; start-ui
;   (ui:warn-about-certs)			; start-ui
;   (maybe-background)			; definitions
;   (wb:maybe-run-devo)
;   (boot:register)			; finding-other-yentas.  [Should we maybe tie this to leaving the first page, w/user permission?]
;   (boot:start-udp-listener)		; finding-other-yentas
;   (boot:maybe-find-yentas)		; finding-other-yentas
;   (vars:start-checkpointing)		; persistence
;   ;; Start all processes.
;   (scheduler:initialize!)		; start-ui
;  )

;;; Get some random bits so the very first browser SSL connection doesn't cause us to flip out.
;;; This is cheesy, but oh well.  Hopefully it'll work just fine on machines /dev/random, and
;;; acceptably on those that don't have that.
(define (wb:get-some-randomness)
  (ssl:force-entropy! 512 nil)		; Might as well ask for a bunch.  Don't use the keyboard.
  (sleep (1+ (random 3)))		; Wait a second or three...
  (ssl:force-entropy! 512 nil))		; If we're on an unlucky machine, maybe asking again will help.

;;; Brings up just enough of Yenta to ask the user for the passphrase
(define (wb:start-yenta-browser . yenta-name-override)
  (format-debug 0 "~&SYB entry.~&")
  (when (and (pair? yenta-name-override)
	     (string? (car yenta-name-override)))
    (set! *yenta-name-override* (car yenta-name-override)))
  (maybe-create-yenta-directory)	; wobbling [here]
  (interests:maybe-create-savantrc)	; create-savantrc
  (format-debug 0 "~%about to v:t-l-b-c~&")
  (let ((found-file? (vars:try-loading-browser-cert))) ; encryption
    (format-debug 0 "~%wb:start-yenta-browser found-file? = ~S~&" found-file?)
    (cond (found-file?
	   (set! *ui:startup-state* 'envelope-read)
	   (wb:get-some-randomness))	; Do this after we've given a URL to the user, so we can think while he types.
	  (t				; If we didn't find the file, must ask for random bits.
	   (set! *ui:startup-state* 'brand-new-yenta)
	   (ssl:generate-random-state)
	   (init-keys))))
  (ssl:initialize!)			; We need this to be initialized so we can bring up an SSL connection.
  (ui:compute-available-httpd-port)	; start-ui
  (ui:warn-about-certs)			; start-ui
  (maybe-background)			; definitions
  (wb:maybe-run-devo)
  ;; Start all processes.
  (scheduler:initialize!)		; start-ui
  (format-debug 0 "~&SYB exit.~&")
  )

;;; Set to #t once we're done, so we don't have to be careful to only call wb:start-yenta-completely once,
;;; which turns out to be a little bit of a pain 'cause of the complexity of the startup state machine.
;;; We can't call it twice, since it creates processes, opens databases, inits things, and generally does
;;; a whole bunch of non-idempotent actions that will blow out if we try to do them again.
;;;
;;; Note that this this is (now) a bit of a misnomer---it does -not- include whether we've started interyenta!
(defvar *wb:yenta-started-completely* #f)

;;; Whether interyenta is up.
(defvar *wb:started-interyenta* #f)

;;; This is for debugging only!  It turns off both InterYenta -and- the UDP
;;; port registration stuff, so it's possible to have multiple Yenta running
;;; on one machine without tripping over them---so long as you're not doing
;;; anything with the network, that is.  Timesharing support will presumably
;;; make this irrelevant.
(defvar *wb:inhibit-non-browser-networking* #f)	; Set this #t only in certain debugging scenarios.

;;; Only useful to run if we already have interests.
(define (wb:start-interyenta-tasks)
  (format-debug 0 "~&SIT entry.~&")
  (cond (*wb:inhibit-non-browser-networking*
	 (format-debug 0 "~&*** SIT:  All non-browser networking inhibited. ***~&"))
	(t
	 (when *wb:started-interyenta*
	   (format-debug 0 "~&IY already started.~&"))
	 (unless *wb:started-interyenta*
	   (connection-scavenger)	; wobbling [here]
	   (start-yenta-server)		; protocol
	   (iy:create-outgoing-yenta-task) ; protocol
;	   (identity:revisit-old-periodically) ; identity  [this -still- blows out...  3/30/99]
	   (interests:schedule-intro-checker) ; accessors
	   (boot:reregister-periodically)
	   (set! *wb:started-interyenta* #t))))
  (format-debug 0 "~&SIT exit.~&"))

;;; Brings up the rest of Yenta after asking for the passphrase.
(define (wb:start-yenta-completely)
  (format-debug 0 "~&SYC entry.~&")
  (when *wb:yenta-started-completely*
    (format-debug 0 "~&Yenta already started completely.~&"))
  (unless *wb:yenta-started-completely*
    (manage-persistent-yenta-versions)	; wobbling [here]
    ;; Initialize interests.
    (init-interests)			; definitions
    ;; Initialize crypto.
    (ssl:generate-random-state)		; ssl
    (init-keys)				; definitions
    (ssl:initialize-pool-tasks!)	; ssl
    ;; Initialize statistics.
    (ctr:count-minutes)			; counters
    (stats:create-tasks)		; log-client
    (inc! *ctr:startups*)		; counters
    (stats:log-event ':startup)		; log-client
    ;; Initialize networking.
    (init-interyenta)			; definitions [must happen -after- init-keys!]  This opens databases, but does -not- start up the network!
;    (connection-scavenger)		; wobbling [here]
;    (start-yenta-server)		; protocol
;    (iy:create-outgoing-yenta-task)	; protocol
    (cond (*wb:inhibit-non-browser-networking*
	   (format-debug 0 "~&*** SYC:  All non-browser networking inhibited. ***~&"))
	  (t
	   (boot:register)		; finding-other-yentas.  [Should we maybe tie this to leaving the first page, w/user permission?]
	   (boot:start-udp-listener)	; finding-other-yentas
	   (boot:maybe-find-yentas)))	; finding-other-yentas
    (vars:start-checkpointing)		; persistence
    (set! *ui:yid-printed-length* (string-length (local-binary-yid->user-rep)))	; Used in various forms, etc.
    (set! *wb:yenta-started-completely* #t) ; We're done.
    )
  (format-debug 0 "~&SYC exit.~&"))

;;; How many seconds in the future the expiration date may be set.
;;; If it's more than this and this is a customer world, then we've
;;; screwed up and are releasing a version that's valid too long.
;;; Eventually, of course, this will be infinite/removed and expirations
;;; will never happen, but not yet...
;;; [Let's just set this dynamically, instead of checking & complaining.]
;;; (define *yenta-customer-expiration-too-long* (* 30 24 60 60))

;;; How long in the future a customer expiration date should be.
;;; This should increase as releases become more stable.
(define *yenta-customer-expiration-delta* (* 2 7 24 60 60)) ; Let's start with two weeks.

;;; +++
;;; Unless we're only loading UI pages, one of dump-yenta-developer or
;;; dump-yenta-customer will be run by dump-yenta. Both of them happen
;;; before we preload the UI pages, so that, if they check for errors,
;;;  we'll blow out quickly.  If we're only loading UI pages, then we
;;; don't do any of this stuff.
(define (wb:dump-yenta-developer)	; Things that we should do specially for a devo world.
  (wb:load-and-set-developer-world))

(define (wb:dump-yenta-customer)	; Things that we should do specially for a customer world.
  (wb:when *wb:developer-world*
    (error "You're trying to dump a customer world that used to be a developer world.")) ; Seems safer just to disallow this...
  (set! format-debug-level -1)		; No keyboard in customer worlds, so inhibit even (format-debug 0 ...), which is everywhere, alas.
  (set! *yenta-expiration-date*	(+ (current-time) *yenta-customer-expiration-delta*))
  (format t "~& ***** This Yenta will expire on ~A. *****~2&" (date-string *yenta-expiration-date*))
  (set! *prot:errors-to-stat-server* t)	; Customer worlds get their errors in scheduled tasks logged to the stats logger.
  (set! *prot:verbose-error-reports* t) ; ...and do so verbosely.
  )

(define (wb:dump-yenta-pages-only)
  #f)					; Nothing special, at least for now.
;;; ---

(define (wb:preload-ui-pages)
  (ui:preload-ui-pages *wb:last-page-load-time*)
  (set! *wb:last-page-load-time* (current-time))) ; Can't use (car *wb:dump-times* 'cause last dump might not have done a preload.

;;; Devo is one of #f, #t, or a positive or negative number; see comments at wb:wobble-yenta.
(define (wb:load-yenta devo? . no-ui?)	; If you don't want UI pages loaded, call this with an optional second argument that isn't #f.
  (when (one-persona-per-host? devo?)
    (format t "~&--> Setting *yenta-one-persona-per-host* <--~2&")
    (set! *yenta-one-persona-per-host* #t))
  (cond ((load-pages-only? devo?)
	 (when (> *wb:last-page-load-time* 0)
	   (error "You're trying to only load UI pages in a world that's already had them loaded."))
	 (format t "~&--> Only loading UI pages <--~2&")
	 (wb:load-yenta-internal #t)
	 (wb:preload-ui-pages)
	 (wb:dump-yenta-pages-only))
	(t
	 (wb:load-yenta-internal #f)
	 (if devo?
	     (wb:dump-yenta-developer)
	     (wb:dump-yenta-customer))
	 (unless (and (pair? no-ui?) (car no-ui?))
	   (wb:preload-ui-pages)))))

;;; Debugging function that saves repetitive typing during hand-loading.
;;; First optional arg, if t, means not to load a UI; second optional arg, if t, sets *yenta-one-persona-per-host*.
(define (wbs . options)
  (let ((no-ui? (and (pair? options) (car options)))
	(host? (and (pair? options) (pair? (cdr options)) (cadr options))))
    (wb:load-yenta (if host? 'host t) no-ui?)
    (wb:start-yenta-browser)))

;;; Flags is nil for a customer world, t for a devo world, a positive number for a devo world with *yenta-one-persona-per-host* set,
;;; or a negative number for a world that has -only- loaded the UI pages and done nothing else.  Yes, this grossly overloads the
;;; meaning of the flag.  Deal.  Note that a numeric arg of 0 is undefined!  Don't use it.
(define (wb:wobble-yenta . flags)
  (let* ((devo? (and (pair? flags) (car flags))) ; Passing non-t/nil through depends on value of AND being value of last clause.
	 (toplevel (if (load-pages-only? devo?)
		       #f		; If we're only loading pages, then the dumped image just has a normal SCM repl loop as its toplevel.
		       wb:start-yenta-browser))); Otherwise, it's got the custom Yenta toplevel.
    (wb:dump "yenta" devo? toplevel wb:load-yenta)))

;;;; Producing various other worlds.

;;; Things that any world is gonna need.  Basically, now that the scheduler tries to
;;; catch errors -and- both increment counters (requiring counters and persistence)
;;; and perhaps log them, we'll need a variety of files.  Devo worlds also tend to
;;; need an srepl, but we'll let wb:load-and-set-developer-world do that if necessary.
;;;
;;; NAME below is the name of the server (assumed) that we're defining.  This is used
;;; to make separate places to save state, so the servers' various vars.scm files don't
;;; overwrite each other, and also to make distinguished *stats:id-hex* values.  Note
;;; that servers which use the stat server will have to call whatever stats functions
;;; they want (setting up periodic logging, or just logging at particular times) themselves.
(define (wb:load-core-infrastructure name)
  (yreq "Parameters/persistence")
  (yreq "Logging/counter-tools")
  (yreq "Logging/counters")
  (yreq "Logging/logger")
  (yreq "Logging/log-client")
  (yreq "Scheduler/nonblocking-io")
  (yreq "Scheduler/scheduler")
  (yreq "Utilities/yenta-utils")	; Anything that saves state needs to know where, which is defined here.
  (eval `(begin
	   (set! *yenta-name-override* 
		 (format nil "/etc/Yenta/~A/" ,name)) ; Only works on Bella.  This is where we'll save state.
	   (set! *stats:id-hex*
		 (format nil "***~A***" ,name))
	   (set! *prot:errors-to-dbg-server* t)	; Server worlds get their errors in scheduled tasks logged to the debugging logger.
	   (set! *prot:verbose-error-reports* t) ; ...and do so verbosely.
	   ))
  )

;;; NOTE:  If you set variables in a load function with set! that are defined by code being loaded,
;;; even if you do it -after- the yreq, you'll probably still have to do it inside an eval to keep
;;; SCM from evaluating the form too early and blowing out with an unbound-variable error.

;;; The debugging logger.

(define (wb:load-dbg-log)
  (wb:load-core-infrastructure "DBG-log")
  (yreq "Logging/logger")
  (eval '(set! logger:pathname "/mas/agents/projects/Yenta/DBG-Logs/log")))

(define (wb:wobble-dbg-log . flags)
  (wb:dump-stereotyped "yenta-dbg-log" flags 'logger:initialize wb:load-dbg-log))

;;; The bootstrap server.

(define (wb:load-bootserver)
  (wb:load-core-infrastructure "Bootserver")
  (yreq "InterYenta/finding-other-yentas")
  (eval '(set! *boot:we-are-central-server* #t)))

(define (wb:wobble-bootserver . flags)
  (wb:dump-stereotyped "yenta-bootserver" flags 'boot:central-server-initialize wb:load-bootserver))

(define (bcs)	; %%% Debuggery:  pretend we're the central server, even though we came up as a normal Yenta already.  Call by hand from srepl.
  (set! *boot:we-are-central-server* #t)
  (boot:yt-make)
  (set! *boot:prune-interval* 5)
  (set! *boot:prune-staleness* 5)
;  (boot:prune-old-yentas)
  )
(define (wbc)	; %%% Debugging function.
  (wb:load-bootserver t)
  (wb:maybe-set-devo t)
  (wb:maybe-run-devo)
  (bcs)
  (boot:central-server-initialize))

;;; The statistics collector.

(define (wb:load-stats)
  (wb:load-core-infrastructure "Stats")
  (req "Statistics/Collection/log-server"))

(define (wb:wobble-stats . flags)
  (wb:dump-stereotyped "yenta-stats" flags 'stats:initialize wb:load-stats))

;;; The statistics logfile reformatter (for use by Perl scripts).
;;;
;;; Note that it's not clear to me that dumping a devo version of this makes any sense,
;;; since the reformatter doesn't run a scheduler, etc etc.

(define (wb:load-stats-reformatter)
  (req "Statistics/Analysis/reformatter"))

(define (wb:wobble-stats-reformatter . flags)
  (wb:dump-stereotyped "yenta-stats-reformatter" flags 'stats:reformat wb:load-stats-reformatter))

;;; Since we loaded stuff that produces un-line-terminated output,
;;; emit a newline for convenience's sake.
(newline)

;;; End of file.
