#lang racket/base
;; For legal info, see file "info.rkt"

(require mzlib/os
         (planet neil/charterm:2:5)
         (planet neil/gdbdump)
         (planet neil/mcfly)

(doc (section "Introduction")

     (section-index "cloud computing")
     (section-index "cloud server")
     (section-index "management console")
     (section-index "operator console")
     (section-index "logging")
     (section-index "logger")
     (para "The "
           " package provides an easy way to add a user interface for system
operators to server processes implemented in Racket.  This interface may be run
within a detachable "
           (hyperlink "http://en.wikipedia.org/wiki/Tmux"
                      (code "tmux"))
           " or "
           (hyperlink "http://en.wikipedia.org/wiki/GNU_Screen"
                      "GNU Screen")
           " session, such as when accessing a "
           (as-index "cloud server")
           " via SSH.")

     (margin-note "ProTip: In 2012, spelling ``server'' as ``cloud server''
gets you more money.")

     (para "Rackonsole is intended to run for GNU/Linux, and similar Unix-like
systems.  It works with terminals supported by the "
           (hyperlink "http://www.neilvandyke.org/racket-charterm/"
                      (code "charterm"))
           " package.  A Rackonsole user interface can be accessed from Apple
Macintosh and Microsoft Windows systems as well, if they are running compatible
terminals (such as in SSH programs, terminal emulators, or some ``terminal'' or
``command'' windows."))

(doc (subsection "Features")

     (para "Rackonsole"
           " currently provides the following features to the operator:")


      (item "View logging information from the application, including ability
to change both what levels of log messages are captured and which are displayed
on the screen.  So, for example, "
            " might be capturing all log levels at the moment, but the operator
can temporarily narrow the display to only errors.  The operator can also
increase and lower the level of messages captured dynamically, to adjust the
balance between information and performance.")

      (item "Quit the application in a manner specified by the developer,
rather than merely Ctrl-C-ing or sending other signals that might not cause an
orderly shutdown.  The application can specify a shutdown procedure in the
code, in the call to "
            (racket rackonsole)

      (item "Generate debugging information to provide to a developer who does
not have access to the server.  In the current version, this is via "
            (hyperlink "http://www.neilvandyke.org/racket-gdbdump/"
                       (code "gdbdump"))

      (item "A sense that the application is running.  Also, by default, the
title includes the application name and server name, for ease when dealing with
multiple applications and servers."))

     (para "Rackonsole"
           " may be used in conjunction with the "
           (code "PLTSYSLOG")
           " environment variable, with "
           (code "racksonsole")
           " providing an easy display of current activity of a process, and Syslog providing centralized and long-term logging."))

(doc (subsection "Easy to Add")

     (para "Adding "
           " to an existing application can be done in a couple lines of code,
depending on how you count lines of code.  Basically, you add a "
           (racket require)
           " for the "
           " PLaneT package, and you apply the "
           (racket rackonsole)
           " procedure in a thread near the start of your program.  For
example, if your application looks like this:")

     (filebox "myserver.rkt"
        (UNSYNTAX (code "#lang racket"))
        (require "myinternals.rkt")

        (for ((request (my-start-server)))
                (lambda (exn)
                  (log-error (string-append "Request failed: "
                                            (exn-message exn))))))
            (my-handle-request request)))))

     (para "Then, if you just want the default options for "
           ", you can simply add a "
           (racket require)
           " and a call to start "
           (racket racksonsole)
           " in a thread.")

     (margin-note "Talk about rapid agile development!")

     (filebox "myserver.rkt"
        (UNSYNTAX (code "#lang racket"))
        (require "myinternals.rkt"
                 (code:hilite (planet neil/rackonsole)))

        (code:hilite (thread rackonsole))

        (for ((request (my-start-server)))
                (lambda (exn)
                  (log-error (string-append "Request failed: "
                                            (exn-message exn))))))
            (my-handle-request request)))))

     (para "If you want to set some options, such as a quit procedure, changing
the default capture level to include warning messages, and the identifying
title to be displayed on the "
           " screen, it's only slightly more complicated:")

     (filebox "myserver.rkt"
        (UNSYNTAX (code "#lang racket"))
        (require "myinternals.rkt"
                 (code:hilite (planet neil/rackonsole)))
          (lambda ()
            (rackonsole #:title         "MyApp 2000"
                        #:capture-level 'warning
                        #:quit-proc     (lambda ()
                                          (display "Farewell!\n")

        (for ((request (my-start-server)))
                (lambda (exn)
                  (log-error (string-append "Request failed: "
                                            (exn-message exn))))))
            (my-handle-request request)))))

     (para "That's pretty much all you have to do (or can do, for that

(doc (subsection "See a Demo")

     (para "You can install "
           " and run a demonstration of it with the command:")

     (commandline "racket -W none -p neil/rackonsole/demo")

     ;; TODO: !!! Describe layout of the interface, and then show how they can
     ;; adjust Log View to Debug, for example.

     (para "Following sections of this documentation describe how to operate "
           ", and provide details of the programming interface."))

;; TODO: Document: Somewhere in here, mention that tries not to use much
;; resources.  For example, doesn't automatically adjust for window size
;; changes.

(doc (section "User Interface")

     (para "The Rackonsole user interface has a few parts:")


      (item (deftech "Title")
            " --- The Title is usually the upper-left corner, in reverse-video,
and usually identifies the application and/or server.")
      (item (deftech "Status")
            " --- The Status is usually the upper-right corner, and displays
the current state of the "
            (tech "capture level")
            " and "
            (tech "view level")
            ".  (If the terminal is not wide enough to put both the Title and
Status on the same row, such as if the Title is long, then both are centered on
their own rows.)")

      (item (deftech "Menu")
            " --- The Menu is centered below the Title and Status, and usually
underlined.  It identifies which menu it is, and shows a list of keys that can
be pressed, with each key surrounded by square brackets.  Menus that are not
the "
            (onscreen "Main")
            " menu can generally be escaped out of by pressing the "
            (bold "-")
            " (minus), "
            (bold "Backspace")
            ", "
            (bold "Esc")
            " key.  (Additionally, the "
            (onscreen "Quit")
            " menu is escaped by any key that is not the "
            (bold "Y")
            " key, to decrease the likelihood of quitting the application accidentally.)")

      (item (deftech "Log View")
            " --- The Log View takes the rest of the screen.  The most recent
captured log entries corresponding to the "
            (tech "view level")
            " are displayed here, with the most recent entries at the top.  As
new entries are captured and viewed, older entries scroll off the bottom of the
screen (but might be viewed again later by restricting the view level).
Entries with "
            (racket 'error)
            " level and higher are in boldface on terminals supporting that.
Each entry is truncated to the width of the terminal."))

     (para "The following subsections describe operation in terms of tasks."))

(doc (subsection "When Changing or Resizing Terminals")

     (margin-note "Did we mention we do cloud $erver$.")

     (para "When the terminal is changed, such as when reattaching a Screen or "
           (code "tmux")
           " session, or when resizing an XTerm, you can select "
           (onscreen "[R]edraw")
           " from the "
           (onscreen "Main")
           " menu to detect the current terminal size and redraw.")

     (para "(Note that Rackonsole technically could detect terminal changes
without needing to press the "
           (bold "R")
           " key, but that would increase the additional load on the system, potentially slowing responsiveness of the main server process.)"))

(doc (subsection "Setting What to Capture and View")

     (para "The "
           (deftech "capture level")
           " specifies the log level of messages to capture.  The "
           (deftech "view level")
           " specifies the level of messages to view currently.  They are changed from the "
           (onscreen "[C]apture")
           " and "
           (onscreen "[V]iew")
           " items of the "
           (onscreen "Main")
           " menu, to go to the "
           (onscreen "Capture")
           " or "
           (onscreen "View")
           " menu.")

     (para "On the "
           (onscreen "Capture")
           " and "
           (onscreen "View")
           " menus, the options are abbreviated: "
           (onscreen "[N]")
           " for "
           (italic "none")
           ", and "
           (onscreen "[F]")
           " through "
           (onscreen "[D]")
           " for "
           (racket 'fatal)
           " through "
           (racket 'debug)

     (para "Note that adjusting the "
           (tech "view level")
           " to a lower level can cause messages previously captured but not
viewed to be displayed.")

     (para "Note that, the lower the "
           (tech "capture level")
           ", the more resources the application might use.  For example, your application might leave "
           (racket log-debug)
           " forms not commented-out, and if any log receiver, such as Rackonsole, registers interest in "
           (racket 'debug)
           " messages, then the application does additional work to generate
and send those messages."))

(doc (subsection "Debugging")

     (para "Currently, Rackonsole has only one debugging option: to run the "
           (hyperlink "http://www.neilvandyke.org/racket-gdbdump/"
                      (code "gdbdump"))
           " tool to get native stack traces of native threads.  This might be
useful if you suspect a system-level problem, such as in system calls.")

     (para "You can perform this by starting at the "
           (onscreen "Main")
           " menu, and selecting "
           (onscreen "[D]ebug")
           " and then "
           (onscreen "[G]dbdump")
           ".  Then (assuming the application has not overridden "
           (code "gdbdump")
           ") wait 10 seconds, and get the file, which likely will be in "
           (filepath "/var/tmp/gdbdump")
           ".  Rackonsole itself will freeze for the 10 seconds, to try to
increase the likelihood that the native dump will capture information about the
more interesting main application rather than Rackonsole.  The main application
should pause only briefly, if noticeably at all."))

(doc (subsection "Quitting")

     (para "To quit the application, select "
           (onscreen "[Q]uit")
           " from the "
           (onscreen "Main")
           " menu, then select "
           (onscreen "[Y]es")
           ".  Rackonsole will clear the screen and restore the terminal to a
normal state, and then execute any special quit procedure that the application

(doc (subsection "Handling Log Flood")

     (para "If the log is being flooded, such as if the application is having a
bad day, you can temporarily set the "
           (tech "capture level")
           " to "
           (onscreen "[N]")
           " (none), to potentially decrease the logging load on the
application.  Then you might wish to adjust the "
           (tech "view level")
           " to see the pertinent messages, and then resolve the problem with
the application."))

(doc (section "Programming Interface")

     (para "The main interface is the "
           (racket rackonsole)
           " procedure.")

     (para "One important thing to note: by default, Racket will write all messages level "
           (racket 'error)
           " and higher from the default logger to "
           (code "stderr")
           ", which will usually go to the same TTY that Rackonsole is using,
corrupting the display a bit.  So, you will want to either disable this logging
to "
           (code "stderr")
           " (with the "
           (code "-W none")
           " command line option to "
           (code "racket")
           ", or by setting the "
           (code "PLTSTDERR")
           " environment variable of the "
           (code "racket")
           " process to "
           (code "none")
           "), or create a new "
           (racket current-logger)
           " (to which your application writes, and which is monitored by

;; TODO: Document needing "-W none" or to set PLTSTDERR.

(define (%rackonsole:get-program-name)
  (let ((path (find-system-path 'run-file)))
    (if (path? path)
        (let-values (((base name dir?) (split-path path)))
          (cond ((path? name) (path->string name))
                ((string? name) name)
                (else #f)))

(doc (defproc* (((program-rackonsole-title)             string?)
                ((hostname-rackonsole-title)            string?)
                ((program-on-hostname-rackonsole-title) string?))
       (para "These procedures can be used for the "
             (racket #:title)
             " argument of "
             (racket rackonsole)
             ".  You can also use them as part of your own procedure, such
        (lambda ()
          (string-append "MyApp on "
       (para "Note that the program name as detected by these procedures will
often be "
             (racket "racket")
             " unless the "
             (Flag "N")
             " command line argument to "
             (code "racket")
             " is used.")))
(provide program-rackonsole-title)
(define (program-rackonsole-title)
  (or (%rackonsole:get-program-name) "???"))

(provide hostname-rackonsole-title)
(define (hostname-rackonsole-title)
  (or (gethostname) "???"))

(provide program-on-hostname-rackonsole-title)
(define (program-on-hostname-rackonsole-title)
  (string-append (program-rackonsole-title)
                 " on "

(define (%rackonsole:center-column screen-width object-width)
  (max 1 (truncate (+ 1 (/ (- screen-width object-width) 2)))))

(define (%rackonsole:log-level->include-levels log-level)
  (if log-level
      (memq log-level '(debug info warning error fatal #f))

(doc (defproc (rackonsole
               (#:tty       tty       (or/c #f path-string?)  #f)
               (#:title     title     (or/c #f string?)       #f)
               (#:logger    logger    logger?                 (current-logger))
               (#:log-size      log-size  exact-positive-integer? 1000)
               (#:capture-level capture-level (or/c #f 'fatal 'error 'warning 'info 'debug) 'error)
               (#:view-level view-level (or/c #f 'fatal 'error 'warning 'info 'debug) 'debug)
               (#:quit-proc quit-proc (-> any)                #f))
       (para "This is the main procedure of Rackonsole.  You usually want to
start it in its own thread.  All arguments are optional.")

       (para (racket #:tty)
             " is the TTY to use, and defaults to "
             (filepath "/dev/tty")
             ".  You probably don't need to change this.")

       (para (racket #:title)
             " is the title to display on the screen.  By default, this is ``"
             (italic "program")
             " on "
             (italic "server")
             ".'' For example: ``myprogram on myserver")

       (para (racket #:logger)
             " is the logger to use.  Defaults to "
             (racket (current-logger))

       (para (racket #:log-size)
             " is the number of lines of captured log messages to store in a ring buffer.  Default is 1000.")

       (para (racket #:capture-level)
             " is the "
             (tech "capture level")
             ", which is either the usual Racket symbol or "
             (racket #f)
             " for none.  Default is "
             (racket 'error)

       (para (racket #:view-level)
             " is the "
             (tech "view level")
             ".  Default is "
             (racket 'error)

       (para (racket #:quit-proc)
             " is a thunk to apply after the operator quits the application via the user interface, or "
             (racket #f)
             " for none.  If non-"
             (racket #f)
             ", this is applied after Rackonsole has cleared the screen and
restored the terminal.")

       (para "The "
             (racket rackonsole)
             " procedure normally returns only when the application is quit from the user interface.")))

(provide rackonsole)
(define rackonsole
  (let* ((status-bytes                  #"Capture: ??????? View: ???????")
         (status-bytes-len              (bytes-length status-bytes))
         (log-capture-status-col-offset 9)
         (log-view-status-col-offset    23)
         (log-level-to-status-bytes-hash (make-hasheqv '((#f      . #"None   ")
                                                         (fatal   . #"Fatal  ")
                                                         (error   . #"Error  ")
                                                         (warning . #"Warning")
                                                         (info    . #"Info   ")
                                                         (debug   . #"Debug  "))))
         (log-level-to-prefix-bytes-hash (make-hasheqv '((#f      . #"Console: ")
                                                         (fatal   . #"FATAL: ")
                                                         (error   . #"ERROR: ")
                                                         (warning . #"WARNING: ")
                                                         (info    . #"Info: ")
                                                         (debug   . #"Debug: ")))))
    (lambda (#:tty       (tty       #f)
                         #:title     (title      #f)
                         #:logger    (logger    (current-logger))
                         #:log-size  (log-size  1000)
                         #:capture-level (capture-level 'error)
                         #:view-level (view-level 'debug)
                         #:quit-proc (quit-proc #f))
      (let* ((title       (or title (program-on-hostname-rackonsole-title)))
             (title-len   (string-length title))
             (log-ringbuf (%rackonsole:ringbuf/size log-size)))
         (let ((ct (current-charterm)))

           (let loop-log-view-change ((view-level        view-level)
                                      (old-capture-level #f)
                                      (old-log-receiver      #f)
                                      (capture-level     capture-level))

             (let ((log-view-includes (%rackonsole:log-level->include-levels view-level)))
               ;; TODO: Straighten out this strangeness with the logging args to loop-redraw and such.
               (let loop-redraw ((old-capture-level old-capture-level)
                                 (old-log-receiver      old-log-receiver)
                                 (capture-level     capture-level))
                 (let*-values (((width height) (charterm-screen-size))
                               ((status-col) (- width status-bytes-len -1))
                               ((titlebar title-col title-row status-col status-row)
                                (if (> (- status-col title-len) 3)
                                    ;; Same row for title and menu.
                                    (values (string-append " " title " ")
                                    ;; Separate rows for title and menu
                                    (values (string-append " " title " ") ;; TODO: Handle title longer than width
                                            (%rackonsole:center-column width status-bytes-len)
                               ((menu-row) (+ 1 status-row))
                               ((data-row) (+ 1 menu-row))
                                (lambda (level str)
                                  (let ((prefix-bytes (hash-ref log-level-to-prefix-bytes-hash
                                    (charterm-cursor 1 data-row)
                                    (if (memq level '(#f fatal error))
                                        (begin (charterm-bold)
                                               (charterm-display #:width width
                                                                 #:truncate #t
                                                                 #:pad #f
                                                                 prefix-bytes str)
                                        (charterm-display #:width width
                                                          #:truncate #t
                                                          #:pad #f
                                                          prefix-bytes str))))))
                   (charterm-cursor title-col title-row)
                   (charterm-display #:width width
                                     #:truncate #t
                                     #:pad #f
                   (charterm-cursor status-col status-row)
                   (charterm-display status-bytes)

                   ;; Note: We display the entries in reverse order to match
                   ;; how they're displayed one-by-one, and to avoid terminal
                   ;; problems such as cursor in last column of last row.
                   (let loop ((stream (sequence->stream log-ringbuf))
                              (num    (max 0 (- height menu-row ))))
                     (or (zero? num)
                         (stream-empty? stream)
                         (let* ((item  (stream-first stream))
                                (level (vector-ref item 0)))
                           (if (memq level log-view-includes)
                               (begin (loop (stream-rest stream)
                                            (- num 1))
                                      (display-log-entry level (vector-ref item 1)))
                               (loop (stream-rest stream)

                   (let loop-log-capture-change ((old-capture-level old-capture-level)
                                                 (old-log-receiver      old-log-receiver)
                                                 (capture-level     capture-level))
                     (let ((log-receiver (if (eqv? capture-level old-capture-level)
                                             ;; TODO: Maybe, if there's an old log
                                             ;; receiver, find some way to GC it
                                             ;; sooner or otherwise stop it.
                                             (and capture-level
                                                  (make-log-receiver logger
                       ;; TODO: !!! Add entry about capture change to ringbuf and display it
                       (charterm-cursor (+ status-col log-capture-status-col-offset) status-row)
                       (charterm-display (hash-ref log-level-to-status-bytes-hash
                       (charterm-cursor (+ status-col log-view-status-col-offset) status-row)
                       (charterm-display (hash-ref log-level-to-status-bytes-hash

                       (let loop-mode-change ((mode 'main-menu))
                         (charterm-cursor 1 menu-row)
                             (((cursor-offset menu-bytes)
                               (case mode
                                 ((main-menu)    (values 5 #"Main? [R]edraw [C]apture [V]iew [D]ebug [Q]uit"))
                                 ((capture-menu) (values 8 #"Capture? [N] [F] [E] [W] [I] [D] [-]"))
                                 ((view-menu)    (values 5 #"View? [N] [F] [E] [W] [I] [D] [-]"))
                                 ((debug-menu)   (values 6 #"Debug? [G]dbdump [-]"))
                                 ((quit-menu)    (values 5 #"Quit? [Y]es [N]o"))
                                 (else           (values 0 #"???"))))
                              ((menu-col) (%rackonsole:center-column width (bytes-length menu-bytes)))
                              ((cursor-col) (+ menu-col cursor-offset)))
                           (charterm-cursor menu-col menu-row)
                           (charterm-display #:width width
                                             #:truncate #t
                                             #:pad #f
                           (let loop-in-mode ()
                             (charterm-cursor cursor-col menu-row)
                             (let ((sync-result (if log-receiver
                                                    (sync log-receiver ct)
                                                    (sync ct))))
                               (cond ((vector? sync-result)
                                      (let ((level (vector-ref sync-result 0))
                                            (str   (vector-ref sync-result 1)))
                                        (%rackonsole:ringbuf-prepend! log-ringbuf sync-result)
                                        (and (memq level log-view-includes)
                                             (display-log-entry level str))
                                     ((eq? sync-result ct)
                                      (cond ((charterm-read-key #:timeout 1)
                                             => (lambda (key)
                                                  (case mode
                                                     (case key
                                                       ((#\r #\R)
                                                        (loop-redraw capture-level
                                                       ((#\c #\C)
                                                        (loop-mode-change 'capture-menu))
                                                       ((#\v #\V)
                                                        (loop-mode-change 'view-menu))
                                                       ((#\d #\D)
                                                        (loop-mode-change 'debug-menu))
                                                       ((#\q #\Q)
                                                        (loop-mode-change 'quit-menu))
                                                       (else (charterm-bell) (loop-in-mode))))
                                                     (let ((level-or-back-or-oops
                                                            (case key
                                                              ((#\n #\N) #f)
                                                              ((#\f #\F) 'fatal)
                                                              ((#\e #\E) 'error)
                                                              ((#\w #\W) 'warning)
                                                              ((#\i #\I) 'info)
                                                              ((#\d #\D) 'debug)
                                                              ((#\- escape backspace) 'back)
                                                              (else 'oops))))
                                                       (case level-or-back-or-oops
                                                         ((back) (loop-mode-change 'main-menu))
                                                         ((oops) (charterm-bell) (loop-mode-change 'main-menu))
                                                         (else (if (eqv? level-or-back-or-oops capture-level)
                                                                   (loop-mode-change 'main-menu)
                                                                   (loop-log-capture-change capture-level
                                                    ;; TODO: generalize the code for capture-menu and view-menu.
                                                     (let ((level-or-back-or-oops
                                                            (case key
                                                              ((#\n #\N) #f)
                                                              ((#\f #\F) 'fatal)
                                                              ((#\e #\E) 'error)
                                                              ((#\w #\W) 'warning)
                                                              ((#\i #\I) 'info)
                                                              ((#\d #\D) 'debug)
                                                              ((#\- escape backspace) 'back)
                                                              (else 'oops))))
                                                       (case level-or-back-or-oops
                                                         ((back) (loop-mode-change 'main-menu))
                                                         ((oops) (charterm-bell) (loop-mode-change 'main-menu))
                                                         (else (if (eqv? level-or-back-or-oops view-level)
                                                                   (loop-mode-change 'main-menu)
                                                                   (loop-log-view-change level-or-back-or-oops
                                                     (case key
                                                       ((#\g #\G)
                                                        (charterm-cursor menu-col menu-row)
                                                        (charterm-display "Gdbdump: Wait...")
                                                        (loop-mode-change 'main-menu))
                                                       ((#\- escape backspace)
                                                        (loop-mode-change 'main-menu))
                                                       (else (charterm-bell) (loop-in-mode))))
                                                     (case key
                                                       ((#\y #\Y)
                                                        (printf "Quitting ~S...\r\n" title))
                                                       ((#\n #\N #\- escape backspace)
                                                        (loop-mode-change 'main-menu))
                                                       (else (charterm-bell) (loop-mode-change 'main-menu))))
                                                     (log-warning (format "rackonsole: unknown mode: ~S" mode))
                                                     (loop-mode-change 'main-menu)))))
                                             (charterm-cursor 1 data-row)
                                             (charterm-display "Timeout.")
      (and quit-proc

(doc (section "Known Issues")


      (item "Add a UI menu item to force a GC.")
      (item "Does not yet provide a way to scroll arbitrarily through older
messages in the ring buffer, short of making the terminal screen taller or limiting the view level.")

      (item "Currently truncates each message at the width of the terminal
screen, without providing a way to see all of longer messages, short of making
the terminal screen wider or going to the Syslog.")

      (item "We should add in better handling of unprintable characters in log messages.")

      (item "Maybe detect duplicate adjacent events and log them in a ``last
message repeated N times'' manner.")

      (item "If you get a flood of logging events, having any kind of log
receiver in place can increase the load on the system, mainly by the events
being buffered by Racket indefinitely and increasing memory usage.  We might
add a feature by which Rackonsole detects a flood and backs off for a while,
such as by discarding events, or even detaching itself as a receiver.  Note,
however, that the way Rackonsole handles I/O keeps its menus responsive even in
event of flood.")
      (item "We could make the Rackonsole menus adapt to very small displays,
such as on smartphone SSH clients, by automatically abbreviating.")

      (item "Rackonsole could use a cooler name, but not so cool as to be pretentious.")))

;; TODO: !!! make general menu-draw procedure, and make gdb "wait..." message
;; use it.

(doc history

     (#:planet 1:0 #:date "2012-06-28"
                (item "Initial release. Not yet tested in a production