Overview
| Comment: | Added several pkt creation locations in the server lifecycle. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.64-use-pkts |
| Files: | files | file ages | folders |
| SHA1: |
69e91554f65956da920722571ac3c756 |
| User & Date: | mrwellan on 2017-05-15 14:50:01 |
| Other Links: | branch diff | manifest | tags |
Context
|
2017-05-15
| ||
| 22:59 | Merged in v1.64 Closed-Leaf check-in: 73442a60e6 user: matt tags: v1.64-use-pkts | |
| 14:50 | Added several pkt creation locations in the server lifecycle. check-in: 69e91554f6 user: mrwellan tags: v1.64-use-pkts | |
| 05:30 | Use T not ptype check-in: 5921f8fed0 user: matt tags: v1.64-use-pkts | |
Changes
Modified http-transport.scm from [bb11c9d077] to [01943ec04e].
| ︙ | ︙ | |||
356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 |
(set! sdat *server-info*)
(mutex-unlock! *heartbeat-mutex*)
(if (and sdat
(not changed)
(> (- (current-seconds) start-time) 2))
(begin
(debug:print-info 0 *default-log-port* "Received server alive signature")
sdat)
(begin
(debug:print-info 0 *default-log-port* "Still waiting, last-sdat=" last-sdat)
(sleep 4)
(if (> (- (current-seconds) start-time) 120) ;; been waiting for two minutes
(begin
(debug:print-error 0 *default-log-port* "transport appears to have died, exiting server")
(exit))
(loop start-time
(equal? sdat last-sdat)
sdat)))))))
(iface (car server-info))
(port (cadr server-info))
(last-access 0)
| > > > > > > > > > > > > > | 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 |
(set! sdat *server-info*)
(mutex-unlock! *heartbeat-mutex*)
(if (and sdat
(not changed)
(> (- (current-seconds) start-time) 2))
(begin
(debug:print-info 0 *default-log-port* "Received server alive signature")
(common:save-pkt `((action . alive)
(T . server)
(pid . ,(current-process-id))
(ipaddr . ,(car sdat))
(port . ,(cadr sdat)))
*configdat* #t)
sdat)
(begin
(debug:print-info 0 *default-log-port* "Still waiting, last-sdat=" last-sdat)
(sleep 4)
(if (> (- (current-seconds) start-time) 120) ;; been waiting for two minutes
(begin
(debug:print-error 0 *default-log-port* "transport appears to have died, exiting server")
(common:save-pkt `((action . died)
(T . server)
(pid . ,(current-process-id))
(ipaddr . ,(car sdat))
(port . ,(cadr sdat))
(msg . "Transport died?"))
*configdat* #t)
(exit))
(loop start-time
(equal? sdat last-sdat)
sdat)))))))
(iface (car server-info))
(port (cadr server-info))
(last-access 0)
|
| ︙ | ︙ | |||
475 476 477 478 479 480 481 |
;; (if (eq? *number-non-write-queries* 0)
;; "n/a (no queries)"
;; (/ *total-non-write-delay*
;; *number-non-write-queries*))
;; " ms")
(db:print-current-query-stats)
| | > > > < < | < | | < > | 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 |
;; (if (eq? *number-non-write-queries* 0)
;; "n/a (no queries)"
;; (/ *total-non-write-delay*
;; *number-non-write-queries*))
;; " ms")
(db:print-current-query-stats)
(common:save-pkt `((action . exit)
(T . server)
(pid . ,(current-process-id)))
*configdat* #t)
(debug:print-info 0 *default-log-port* "Server shutdown complete. Exiting")
(exit)))
;; all routes though here end in exit ...
;;
;; start_server?
;;
(define (http-transport:launch)
(common:save-pkt `((action . start)
(T . server)
(pid . ,(current-process-id)))
*configdat* #t)
(let* ((th2 (make-thread (lambda ()
(debug:print-info 0 *default-log-port* "Server run thread started")
(http-transport:run
(if (args:get-arg "-server")
(args:get-arg "-server")
"-")
)) "Server run"))
|
| ︙ | ︙ |
Modified server.scm from [8b3ffe13e6] to [2a78949c4a].
1 2 3 4 5 6 7 8 9 10 11 12 | ;; Copyright 2006-2012, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. (require-extension (srfi 18) extras tcp s11n) | | | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 |
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(require-extension (srfi 18) extras tcp s11n)
(use srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest
directory-utils posix-extras matchable)
(use spiffy uri-common intarweb http-client spiffy-request-vars)
(declare (unit server))
(declare (uses common))
(declare (uses db))
|
| ︙ | ︙ | |||
52 53 54 55 56 57 58 | ;; ;; all routes though here end in exit ... ;; ;; start_server ;; (define (server:launch run-id transport-type) | < < < < | 51 52 53 54 55 56 57 58 59 60 61 62 63 64 |
;;
;; all routes though here end in exit ...
;;
;; start_server
;;
(define (server:launch run-id transport-type)
(case transport-type
((http)(http-transport:launch))
;;((nmsg)(nmsg-transport:launch run-id))
((rpc) (rpc-transport:launch run-id))
(else (debug:print-error 0 *default-log-port* "unknown server type " transport-type))))
;;======================================================================
|
| ︙ | ︙ |