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

Abstract out daemonization

Browse Source
This commit is contained in:
Tony Garnock-Jones 2014-11-10 20:18:59 -05:00
parent 4288c80319
commit a4f4daa445
2 changed files with 28 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/daemon.rkt Normal file
View File

@ -0,0 +1,21 @@
#lang racket/base
(provide daemonize-thunk
daemon-thread)
(require (only-in web-server/private/util exn->string))
(define (daemonize-thunk name boot-thunk)
(lambda ()
(let reboot ()
(with-handlers* ((exn:fail? (lambda (e)
(log-error "*** DAEMON CRASHED: ~a ***\n~a"
name
(exn->string e))
(sleep 5)
(reboot))))
(define result (boot-thunk))
(log-warning "Daemon thread ~a exited normally (returning ~v)" name result)))))
(define (daemon-thread name boot-thunk)
(thread (daemonize-thunk name boot-thunk)))

19
src/packages.rkt
View File

@ -21,9 +21,9 @@
(require racket/string)
(require racket/list)
(require web-server/private/gzip)
(require (only-in web-server/private/util exn->string))
(require net/url)
(require "reload.rkt")
(require "daemon.rkt")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -71,16 +71,11 @@
[next-fetch-deadline (+ (current-inexact-milliseconds) package-fetch-interval)]))
(define (package-manager)
(with-handlers* ((exn:fail? (lambda (e)
(log-error "*** PACKAGE MANAGER CRASHED ***\n~a"
(exn->string e))
(sleep 5)
(package-manager))))
(package-manager-main (package-manager-state (hash)
(set)
(set)
0
base-bogus-timeout))))
(package-manager-main (package-manager-state (hash)
(set)
(set)
0
base-bogus-timeout)))
(define (refresh-packages raw-remote-packages state)
(define local-packages (package-manager-state-local-packages state))
@ -195,7 +190,7 @@
(define package-manager-thread
(make-persistent-state 'package-manager-thread
(lambda () (thread package-manager))))
(lambda () (daemon-thread 'package-manager package-manager))))
(define (manager-rpc . request)
(define ch (make-channel))