From 5a6ed440a1f12107f64fa01f054eb66fb5897b81 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Fri, 10 Feb 2012 06:00:42 -0500
Subject: [PATCH] Allow `get-conf' to be used with any key.

Make it possible to put user settings in the configuration, with the
same benefits (auto-reloading).
---
 collects/handin-server/private/config.rkt     | 40 +++++++++++--------
 .../scribblings/server-setup.scrbl            |  9 +++--
 .../handin-server/scribblings/utils.scrbl     |  8 +++-
 3 files changed, 35 insertions(+), 22 deletions(-)

diff --git a/collects/handin-server/private/config.rkt b/collects/handin-server/private/config.rkt
index 8b91308101..1fe0958c7f 100644
--- a/collects/handin-server/private/config.rkt
+++ b/collects/handin-server/private/config.rkt
@@ -46,29 +46,35 @@
                                (and (pair? x) (symbol? (car x))))
                              c))
               (set! raw-config c)
-              (error "malformed configuration file content"))))
+              (raise-user-error
+               'get-conf "malformed configuration file content"))))
         (set! config-cache (make-hasheq)))))
   (hash-ref config-cache key
     (lambda ()
-      (let*-values ([(default translate) (config-default+translate key)]
-                    ;; translate = #f => this is a computed value
-                    [(v) (if translate
-                           (translate (cond [(assq key raw-config) => cadr]
-                                            [else default]))
-                           default)])
-        (hash-set! config-cache key v)
-        v))))
+      (define-values [default translate] (config-default+translate key))
+      (define v
+        (case translate
+          ;; #f => computed value => return untranslated default w/out lookup
+          [(#f) default]
+          ;; #t => user key => return raw value or error
+          [(#t) (cond [(assq key raw-config) => cadr]
+                      [else (raise-user-error
+                             'get-conf "no value for key: ~e" key)])]
+          [else (translate (cond [(assq key raw-config) => cadr]
+                                 [else default]))]))
+      (hash-set! config-cache key v)
+      v)))
 
-(define (id x) x)
-(define (rx s) (if (regexp? s) s (regexp s)))
-(define (path p) (path->complete-path p server-dir))
+(define (id x)         x)
+(define (rx s)         (if (regexp? s) s (regexp s)))
+(define (path p)       (path->complete-path p server-dir))
 (define (path/false p) (and p (path p)))
-(define (path-list l) (map path l))
-(define (maybe-strs l) (and l
-                            (pair? l)
-                            (map string->bytes/utf-8 l)))
+(define (path-list l)  (map path l))
+(define (maybe-strs l) (and l (pair? l) (map string->bytes/utf-8 l)))
 
 (define (config-default+translate which)
+  ;; translate = #f => a computed value (so no lookup or translation)
+  ;;           = #t => an unknown key (raw return value)
   (case which
     [(active-dirs)             (values '()                   path-list    )]
     [(inactive-dirs)           (values '()                   path-list    )]
@@ -105,7 +111,7 @@
      (values (filter (lambda (f) (not (eq? '- (cadr f))))
                      (get-conf 'extra-fields))
              #f)]
-    [else (error 'get-conf "unknown configuration entry: ~s" which)]))
+    [else (values #f #t)]))
 
 ;; This is used below to map names to submission directory paths and back
 ;; returns a (list-of (either (list name path) (list path name)))
diff --git a/collects/handin-server/scribblings/server-setup.scrbl b/collects/handin-server/scribblings/server-setup.scrbl
index 1824420876..cbc81f1202 100644
--- a/collects/handin-server/scribblings/server-setup.scrbl
+++ b/collects/handin-server/scribblings/server-setup.scrbl
@@ -213,16 +213,19 @@ This directory contains the following files and sub-directories:
                     (apply format "~a: ~s" key+val))
                   alist))))]}}]
 
+  In addition, you can add your own keys --- see @racket[get-conf] for
+  details.
+
   Changes to @filepath{config.rktd} are detected, the file will be
-  re-read, and options are reloaded.  A few options are fixed at startup
+  re-read, and options will be reloaded.  A few options are fixed at startup
   time: port numbers and log file specs are fixed as configured at
   startup.  All other options will change the behavior of the running
-  server (but things like @racketid[username-case-sensitive?]  it would
+  server (but for things like @racketid[username-case-sensitive?] it would
   be unwise to do so).  (For safety, options are not reloaded until the
   file parses correctly, but make sure that you don't save a copy that
   has inconsistent options: it is best to create a new configuration
   file and move it over the old one, or use an editor that does so and
-  not save until the new contents is ready.)  This is most useful for
+  avoid saving until the new contents is ready.)  This is most useful for
   closing & opening submissions directories.}
 
 @item{@filepath{users.rktd} (created if not present when a user is added):
diff --git a/collects/handin-server/scribblings/utils.scrbl b/collects/handin-server/scribblings/utils.scrbl
index 9b7b1d7ac0..c59fd8cd9e 100644
--- a/collects/handin-server/scribblings/utils.scrbl
+++ b/collects/handin-server/scribblings/utils.scrbl
@@ -9,8 +9,12 @@
 
 @defproc[(get-conf [key symbol?]) any/c]{
 
-  Returns a value from the configuration file (useful for reading
-  things like field names, etc.).}
+  Returns a value from the configuration file (useful for reading things
+  like field names, etc.).  Known keys (see @secref{server-setup}) have
+  defaults and some have their values go through a translation (for
+  example, @racket['active-dirs] produces a list of complete paths).
+  Other keys get neither, and an exception is raised if the @racket[key]
+  is not specified.}
 
 @defproc[(unpack-submission [submission bytes?])
          (values (is-a?/c text%) (is-a?/c text%))]{