suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Racketized handin-server

Browse Source
This commit is contained in:
Eli Barzilay 2010-09-12 02:22:01 -04:00
parent bd4a5fb706
commit 6b471afcfd
9 changed files with 56 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/handin-server/checker.rkt
View File

@ -1,10 +1,10 @@
#lang scheme/base
(require (for-syntax scheme/base) "utils.ss"
(require (for-syntax scheme/base) "utils.rkt"
scheme/file scheme/class mred)
(provide (except-out (all-from-out scheme/base) #%module-begin)
(all-from-out "utils.ss"))
(all-from-out "utils.rkt"))
(provide (rename-out [module-begin~ #%module-begin]))
(define-syntax (module-begin~ stx)
@ -43,7 +43,7 @@
;; the student is always assumed to exist
(cdr (get-preference (if (string? user) (string->symbol user) user)
(lambda () #f) 'timestamp
(build-path server-dir "users.ss"))))
(build-path server-dir "users.rktd"))))
(provide user-substs)
(define (user-substs user str)
@ -127,7 +127,8 @@
(let ([name (and (is-a? x snip%)
(send (send x get-snipclass) get-classname))])
(cond [(equal? name "wximage") "{{IMAGE}}"]
[(equal? name "(lib \"comment-snip.ss\" \"framework\")")
[(regexp-match? #rx"(lib \"comment-snip.(?:rkt|ss)\" \"framework\")"
name)
;; comments will have ";" prefix on every line, and "\n" suffix
(format ";{{COMMENT:\n~a;}}\n"
(send x get-text 0 (send x get-count)))]
@ -175,7 +176,7 @@
(define (submission->bytes submission maxwidth textualize? untabify?
markup-prefix bad-re)
(define magic #rx#"^(?:#reader[(]lib\"read.ss\"\"wxme\"[)])?WXME")
(define magic #rx#"^(?:#reader[(]lib\"read.(?:rkt|ss)\"\"wxme\"[)])?WXME")
(unless (regexp-match? magic submission)
(error* "bad submission format, expecting a single DrRacket submission"))
(let-values ([(defs inters) (unpack-submission submission)])

34
collects/handin-server/main.rkt
View File

@ -4,19 +4,19 @@
scheme/port
openssl
scheme/file
"private/logger.ss"
"private/config.ss"
"private/lock.ss"
"private/md5.ss"
"private/run-status.ss"
"private/reloadable.ss"
"private/hooker.ss"
(prefix-in web: "web-status-server.ss")
"private/logger.rkt"
"private/config.rkt"
"private/lock.rkt"
"private/md5.rkt"
"private/run-status.rkt"
"private/reloadable.rkt"
"private/hooker.rkt"
(prefix-in web: "web-status-server.rkt")
;; this sets some global parameter values, and this needs
;; to be done in the main thread, rather than later in a
;; user session thread (that will make the global changes
;; not to be global.)
"sandbox.ss")
"sandbox.rkt")
(install-logger-port)
@ -48,8 +48,8 @@
(lambda (f)
(error 'handin-server
"unable to clean up lock file: ~s" f))
"users.ss"))
"users.ss")
"users.rktd"))
"users.rktd")
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -214,7 +214,7 @@
(save-submission s (build-path ATTEMPT-DIR "handin"))
(timeout-control 'reset)
(log-line "checking ~a for ~a" assignment users)
(let* ([checker* (path->complete-path (build-path 'up "checker.ss"))]
(let* ([checker* (path->complete-path (build-path 'up "checker.rkt"))]
[checker* (and (file-exists? checker*)
(parameterize ([current-directory server-dir])
(auto-reload-value
@ -282,7 +282,7 @@
(parameterize ([current-directory submission-dir])
(define magics '(#"WXME"
#"<<<MULTI-SUBMISSION-FILE>>>"
#"#reader(lib\"read.ss\"\"wxme\")WXME"))
#"#reader(lib\"read.rkt\"\"wxme\")WXME"))
(define mlen (apply max (map bytes-length magics)))
(define file
;; find the newest wxme file
@ -326,12 +326,12 @@
(list (string->symbol username)) (list data)
(lambda (f)
(error* "user database busy; please try again, and alert the adminstrator if problems persist"))
"users.ss"))
"users.rktd"))
orig-custodian))
(define (get-user-data username)
(get-preference (string->symbol username) (lambda () #f) 'timestamp
"users.ss"))
"users.rktd"))
(define (check-field value field-re field-name field-desc)
(unless (cond [(or (string? field-re) (regexp? field-re))
(regexp-match field-re value)]
@ -372,8 +372,8 @@
(error* "username must not begin or end with a space or period"))
(when (regexp-match #rx"^solution" username)
(error* "the username prefix \"solution\" is reserved"))
(when (string=? "checker.ss" username)
(error* "the username \"checker.ss\" is reserved"))
(when (string=? "checker.rkt" username)
(error* "the username \"checker.rkt\" is reserved"))
(when (get-user-data username)
(error* "username already exists: `~a'" username))
(for ([str (in-list extra-fields)]

2
collects/handin-server/private/config.rkt
View File

@ -10,7 +10,7 @@
dir
(error 'config "handin server directory does not exist: ~e" dir))))
(define config-file (path->complete-path "config.ss" server-dir))
(define config-file (path->complete-path "config.rktd" server-dir))
(define poll-freq 2000.0) ; poll at most once every two seconds

2
collects/handin-server/private/hooker.rkt
View File

@ -1,6 +1,6 @@
#lang scheme/base
(require "config.ss" "logger.ss" "reloadable.ss")
(require "config.rkt" "logger.rkt" "reloadable.rkt")
(provide hook)

2
collects/handin-server/private/logger.rkt
View File

@ -1,6 +1,6 @@
#lang scheme/base
(require "config.ss" scheme/date scheme/port)
(require "config.rkt" scheme/date scheme/port)
(provide current-session)
(define current-session (make-parameter #f))

34
collects/handin-server/private/reloadable.rkt
View File

@ -1,6 +1,6 @@
#lang scheme/base
(require syntax/moddep "logger.ss")
(require syntax/moddep "logger.rkt")
(provide reload-module)
(define (reload-module modspec path)
@ -23,24 +23,20 @@
(provide auto-reload-value)
(define module-times (make-hash))
(define (auto-reload-value modspec valname)
(let* ([path (resolve-module-path modspec #f)] ; HACK: set!ed below
[last (hash-ref module-times path #f)]
[cur (file-or-directory-modify-seconds
path
#f
(lambda ()
(if (regexp-match #rx#"[.]rkt$" (path->bytes path))
(file-or-directory-modify-seconds
(begin
(set! path (path-replace-suffix path #".ss"))
path)
#f
(lambda () +inf.0))
+inf.0)))])
(unless (equal? cur last)
(hash-set! module-times path cur)
(reload-module modspec path))
(dynamic-require modspec valname)))
(define path0 (resolve-module-path modspec #f))
(define last (hash-ref module-times path0 #f))
(define-values (path cur)
(let ([s (file-or-directory-modify-seconds path0 #f (lambda () #f))])
(if s
(values path0 s)
(let* ([p (and (regexp-match? #rx#"[.]rkt$" (path->bytes path0))
(path-replace-suffix path0 #".ss"))]
[s (and p (file-or-directory-modify-seconds p #f (lambda () #f)))])
(if s (values p s) (values path0 +inf.0))))))
(unless (equal? cur last)
(hash-set! module-times path cur)
(reload-module modspec path))
(dynamic-require modspec valname))
(define poll-freq 2000.0) ; poll at most once every two seconds

4
collects/handin-server/scribblings/quick-start.scrbl
View File

@ -18,14 +18,14 @@
NOTE: For real use, you need a new key.}
@item{Create a file @filepath{users.ss} with the following content:
@item{Create a file @filepath{users.rktd} with the following content:
@schemeblock[
((tester ("8fe4c11451281c094a6578e6ddbf5eed"
"Tester" "1" "test@cs")))]}
@item{Make a @filepath{test} subdirectory in your new directory.}
@item{Create a file @filepath{config.ss} with the following content:
@item{Create a file @filepath{config.rktd} with the following content:
@schemeblock[((active-dirs ("test")))]}
@item{In your new directory, run

24
collects/handin-server/scribblings/server-setup.scrbl
View File

@ -21,7 +21,7 @@ This directory contains the following files and sub-directories:
distributed to students with the handin client,
@filepath{private-key.pem} is kept private.}
@item{@filepath{config.ss}: configuration options. The file format is
@item{@filepath{config.rktd}: configuration options. The file format is
@verbatim[#:indent 2]{((<key> <val>) ...)}
The following keys can be used:
@ -143,9 +143,9 @@ This directory contains the following files and sub-directories:
#rx"^[^@<>\"`',]+@cs\\.utah\\.edu$"
"A Utah CS email address"))}|
The order of these fields will be used both on the client GUI side
and in the @filepath{users.ss} file (see below).
and in the @filepath{users.rktd} file (see below).
@; JBC: a hyperlink here for users.ss?
@; JBC: a hyperlink here for users.rktd?
The second item in a field description can also be the symbol
@schemeid[-], which marks this field as one that is hidden from the
@ -154,7 +154,7 @@ This directory contains the following files and sub-directories:
fields will be left empty. This is useful for adding information
that you have on students from another source, for example, adding
information from a course roster. You should manually edit the
@filepath{users.ss} file and fill in such information. (The third
@filepath{users.rktd} file and fill in such information. (The third
element for such descriptors is ignored.)}
@item{@indexed-scheme[hook-file] --- a path (relative to handin
@ -206,7 +206,7 @@ This directory contains the following files and sub-directories:
(apply format "~a: ~s" key+val))
alist))))]}}]
Changes to @filepath{config.ss} are detected, the file will be
Changes to @filepath{config.rktd} are detected, the file will be
re-read, and options are 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
@ -218,7 +218,7 @@ This directory contains the following files and sub-directories:
not save until the new contents is ready.) This is most useful for
closing & opening submissions directories.}
@item{@filepath{users.ss} (created if not present when a user is added):
@item{@filepath{users.rktd} (created if not present when a user is added):
keeps the list of user accounts, along with the associated password
(actually the MD5 hash of the password), and extra string fields as
specified by the @schemeid[extra-fields] configuration entry (in the
@ -240,30 +240,30 @@ This directory contains the following files and sub-directories:
pathnames, and they cannot end or begin in spaces or periods.
If the @schemeid[allow-new-users] configuration allows new users, the
@filepath{users.ss} file can be updated by the server with new users.
@filepath{users.rktd} file can be updated by the server with new users.
It can always be updated by the server to change passwords.
If you have access to a standard Unix password file (from
@filepath{/etc/passwd} or @filepath{/etc/shadow}), then you can
construct a @filepath{users.ss} file that will allow users to use
construct a @filepath{users.rktd} file that will allow users to use
their normal passwords. To achieve this, use a list with
@schemeid[unix] as the first element and the system's encrypted
password string as the second element. Such passwords can be used,
but when users change them, a plain md5 hash will be used.
You can combine this with other fields from the password file to
create your @filepath{users.ss}, but make sure you have information
create your @filepath{users.rktd}, but make sure you have information
that matches your @schemeid[extra-fields] specification. For example,
given this system file:
@verbatim[#:indent 2]|{
foo:wRzN1u5q2SqRD:1203:1203:L.E. Foo :/home/foo:/bin/tcsh
bar:$1$dKlU0OkJ$t63TzKz:1205:1205:Bar Z. Lie:/home/bar:/bin/bash}|
you can create this @filepath{users.ss} file:
you can create this @filepath{users.rktd} file:
@verbatim[#:indent 2]|{
((foo ((unix "wRzN1u5q2SqRD") "L.E. Foo" "?"))
(bar ((unix "$1$dKlU0OkJ$t63TzKz") "Bar Z. Lie" "?")))}|
which can be combined with this setting for @schemeid[extra-fields] in
your @filepath{config.ss}:
your @filepath{config.rktd}:
@verbatim[#:indent 2]{
...
(extra-fields (("Full Name" #f #f)
@ -354,7 +354,7 @@ This directory contains the following files and sub-directories:
exception; the exception message will be relayed back to the
student. The module is loaded when the current directory is the
main server directory, so it can read files from there (but note
that to read values from @filepath{config.ss} it is better to use
that to read values from @filepath{config.rktd} it is better to use
@scheme[get-conf]). Also, the module will be reloaded if the
checker file is modified; there's no need to restart the server,
but make sure that you do not save a broken checker (i.e., do not

2
collects/handin-server/web-status-server.rkt
View File

@ -23,7 +23,7 @@
(body ([bgcolor "white"]) (h1 ((align "center")) ,title) ,@body)))
(define get-user-data
(let ([users-file (build-path server-dir "users.ss")])
(let ([users-file (build-path server-dir "users.rktd")])
(unless (file-exists? users-file)
(log-line "WARNING: users file missing on startup: ~a" users-file))
(lambda (user)