116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
;; foreach arf
;; bundle into with-transaction, no-transaction
;; foreach bundle
;; process the request
;; create results arf and write it to clients dir
;; remove in-arf from incoming
(let* ((areapath (srv-areapath srvdat))
(srvinfod (server:get-servinfo-dir areapath))
(myarf (srv->alist srvdat))
(myuuid (write-alist->artifact srvinfod myarf ptype: 'S))
(arf-fname (get-artifact-fname srvinfod myuuid))
(dbstruct (srv-dbstruct srvdat)))
(set! *server-keep-running* #t)
(let loop ()
(let* ((start (current-milliseconds))
(res (server:process-incoming srvdat))
(delta (- (current-milliseconds) start)))
(thread-sleep! (if (> delta 500)
0.1
0.9))
(if (or (> res 0) ;; res is the number of requests that were found and processed
*server-keep-running*)
(loop))))))
;; read arfs from incoming, process them and put result arfs in proper dirs
;; return number requests found and processed
;;
(define (server:process-incoming srvdat)
(let* ((srvdir (srv-dir srvdat))
(indir (srv-incoming srvdat))
|
|
>
>
|
|
|
|
|
>
>
>
>
>
>
>
|
|
|
>
>
>
|
>
>
|
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
;; foreach arf
;; bundle into with-transaction, no-transaction
;; foreach bundle
;; process the request
;; create results arf and write it to clients dir
;; remove in-arf from incoming
(let* ((areapath (srv-areapath srvdat))
(srvdir (srv-dir srvdat)) ;; (server:get-servinfo-dir areapath))
(myarf `((h . ,(srv-host srvdat))
(i . ,(srv-pid srvdat))
(d . ,srvdir))) ;; (srv->alist srvdat))
(myuuid (write-alist->artifact srvdir myarf ptype: 'S))
(arf-fname (get-artifact-fname srvdir myuuid))
(dbstruct (srv-dbstruct srvdat)))
(set! *server-keep-running* #t)
(let loop ((last-access (current-seconds)))
(let* ((start (current-milliseconds))
(res (server:process-incoming srvdat))
(delta (- (current-milliseconds) start))
(timed-out (> (- (current-seconds) last-access)
60)) ;; accessed in last 60 seconds
)
(if timed-out
(begin
(print "INFO: server has not been accessed in 60 seconds, exiting shortly.")
(set! *server-keep-running* #f))
(thread-sleep! (if (> delta 500)
0.1
0.9)))
(if (or (> res 0) ;; res is the number of requests that were found and processed
*server-keep-running*)
(loop (if (> res 0)
(current-seconds)
last-access)
))))
(delete-file arf-fname)
))
;; read arfs from incoming, process them and put result arfs in proper dirs
;; return number requests found and processed
;;
(define (server:process-incoming srvdat)
(let* ((srvdir (srv-dir srvdat))
(indir (srv-incoming srvdat))
|