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

Make `with-watcher' deal with timeouts if not in 3m,

Browse Source 
removed timeout from `run-server'.

svn: r1040
This commit is contained in:
Eli Barzilay 2005-10-11 05:36:32 +00:00
parent b93a25c3ad
commit f30e285be4
1 changed files with 62 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
collects/handin-server/handin-server.ss
View File

@ -35,7 +35,7 @@
;; Assemble log into into a single string, to make ;; Assemble log into into a single string, to make
;; interleaved log lines unlikely: ;; interleaved log lines unlikely:
(let ([line (let ([line
(format "(~a ~s ~s)~n" (format "(~a ~s ~s)\n"
(current-session) (current-session)
(parameterize ([date-display-format 'iso-8601]) (parameterize ([date-display-format 'iso-8601])
(date->string (seconds->date (current-seconds)) #t)) (date->string (seconds->date (current-seconds)) #t))
@ -529,27 +529,23 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define no-limit-warning? #f) (define no-limit-warning? #f) ; will be set to #t if no memory limits
(define (with-watcher w proc) (define (with-watcher w proc)
(if no-limit-warning?
;; Already know watcher doesn't work:
(proc void)
;; Try making a watcher:
(let ([session-cust (make-custodian)] (let ([session-cust (make-custodian)]
[session-channel (make-channel)] [session-channel (make-channel)]
[timeout (+ (current-inexact-milliseconds) [timeout (+ (current-inexact-milliseconds) (* 1000 SESSION-TIMEOUT))]
(* 1000 SESSION-TIMEOUT))]
[status-box (box #f)]) [status-box (box #f)])
(let ([watcher (unless no-limit-warning?
(with-handlers ([exn:fail:unsupported? (with-handlers ([exn:fail:unsupported?
(lambda (x) (lambda (x)
(set! no-limit-warning? #t) (set! no-limit-warning? #t)
(LOG "WARNING: per-session memory limit not supported by MrEd") (LOG "WARNING: per-session memory limit not supported by MrEd"))])
#f)]) (custodian-limit-memory session-cust SESSION-MEMORY-LIMIT session-cust)))
(custodian-limit-memory session-cust SESSION-MEMORY-LIMIT session-cust) (let* ([watcher
(parameterize ([current-custodian orig-custodian]) (parameterize ([current-custodian orig-custodian])
(thread (lambda () (thread
(lambda ()
(let ([session-thread (channel-get session-channel)]) (let ([session-thread (channel-get session-channel)])
(let loop ([timed-out? #f]) (let loop ([timed-out? #f])
(cond (cond
@ -573,12 +569,13 @@
(loop #t)] (loop #t)]
[else [else
(collect-garbage) (collect-garbage)
(LOG "running ~a (~a ~a)" (LOG "running ~a ~a"
(current-memory-use session-cust) (current-memory-use session-cust)
(current-memory-use orig-custodian) (if no-limit-warning?
(current-memory-use)) "(total)"
(loop #f)])))))))]) (list (current-memory-use orig-custodian)
(if watcher (current-memory-use))))
(loop #f)]))))))])
;; Run proc in a thread under session-cust: ;; Run proc in a thread under session-cust:
(let ([session-thread (let ([session-thread
(parameterize ([current-custodian session-cust] (parameterize ([current-custodian session-cust]
@ -592,9 +589,7 @@
(channel-put session-channel 'done-normal))))]) (channel-put session-channel 'done-normal))))])
(channel-put session-channel session-thread) (channel-put session-channel session-thread)
;; Wait until the proc is done or killed (and kill is reported): ;; Wait until the proc is done or killed (and kill is reported):
(channel-get session-channel)) (channel-get session-channel)))))
;; Watcher didn't work:
(proc void))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -649,11 +644,9 @@
;; flushes an internal buffer that's not supposed to exist, while ;; flushes an internal buffer that's not supposed to exist, while
;; the shutdown gives up immediately. ;; the shutdown gives up immediately.
(close-output-port w))))))) (close-output-port w)))))))
(+ SESSION-TIMEOUT 30) ; extra 30 seconds gives watcher thread time to produce a nice message #f ; `with-watcher' handles our timeouts
(lambda (exn) (lambda (exn)
(printf "~a~n" (if (exn? exn) (printf "~a\n" (if (exn? exn) (exn-message exn) exn)))
(exn-message exn)
exn)))
(lambda (port-k cnt reuse?) (lambda (port-k cnt reuse?)
(let ([l (ssl-listen port-k cnt #t)]) (let ([l (ssl-listen port-k cnt #t)])
(ssl-load-certificate-chain! l "server-cert.pem") (ssl-load-certificate-chain! l "server-cert.pem")