Overview
| Comment: | wip. compiles. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.80-tcp-inmem |
| Files: | files | file ages | folders |
| SHA1: |
24ddf5d2356647750304450741f6a73d |
| User & Date: | matt on 2023-02-15 19:28:22 |
| Other Links: | branch diff | manifest | tags |
Context
|
2023-02-15
| ||
| 19:57 | wip check-in: 3528bbcf9e user: matt tags: v1.80-tcp-inmem | |
| 19:28 | wip. compiles. check-in: 24ddf5d235 user: matt tags: v1.80-tcp-inmem | |
| 19:21 | wip. compiles. check-in: 4c52a47431 user: matt tags: v1.80-tcp-inmem | |
Changes
Modified megatest.scm from [f24c5b91ed] to [bfdf2b502e].
| ︙ | ︙ | |||
21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 | ;; fake out readline usage of toplevel-command (define (toplevel-command . a) #f) (declare (uses common)) ;; (declare (uses megatest-version)) (declare (uses margs)) (declare (uses runs)) (declare (uses launch)) (declare (uses server)) (declare (uses client)) (declare (uses tests)) (declare (uses genexample)) ;; (declare (uses daemon)) (declare (uses db)) ;; (declare (uses dcommon)) (declare (uses tdb)) (declare (uses mt)) (declare (uses api)) (declare (uses tasks)) ;; only used for debugging. (declare (uses env)) (declare (uses diff-report)) (declare (uses db)) (declare (uses dbmod)) (declare (uses dbmod.import)) | > > | < | | | > | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | ;; fake out readline usage of toplevel-command (define (toplevel-command . a) #f) (declare (uses common)) ;; (declare (uses megatest-version)) (declare (uses margs)) (declare (uses commonmod)) (declare (uses commonmod.import)) (declare (uses runs)) (declare (uses launch)) (declare (uses server)) (declare (uses client)) (declare (uses tests)) (declare (uses genexample)) ;; (declare (uses daemon)) (declare (uses db)) ;; (declare (uses dcommon)) (declare (uses tdb)) (declare (uses mt)) (declare (uses api)) (declare (uses tasks)) ;; only used for debugging. (declare (uses env)) (declare (uses diff-report)) (declare (uses db)) (declare (uses dbmod)) (declare (uses dbmod.import)) (declare (uses dbfile)) (declare (uses dbfile.import)) (declare (uses tcp-transport)) ;; (declare (uses debugprint)) ;; (declare (uses debugprint.import)) ;; (declare (uses mtargs)) ;; (declare (uses mtargs.import)) ;; (declare (uses ftail)) ;; (import ftail) (import dbmod commonmod dbfile tcp-transport) (define *db* #f) ;; this is only for the repl, do not use in general!!!! (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") (include "run_records.scm") |
| ︙ | ︙ | |||
925 926 927 928 929 930 931 932 933 934 935 936 937 938 |
;;
(if (args:get-arg "-server")
(let* ((run-id (args:get-arg-number "-run-id"))
(tl (launch:setup)))
(case (rmt:transport-mode)
((http)(http-transport:launch))
((tcp)
(if run-id
(tt:start-server tl (dbmod:run-id->dbfname run-id))
(begin
(debug:print 0 *default-log-port* "ERROR: transport mode is tcp - -run-id is required.")
(exit 1))))
(else (debug:print 0 *default-log-port* "ERROR: rmt:transport-mode value not recognised "(rmt:transport-mode))))
(set! *didsomething* #t)))
| > | 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 |
;;
(if (args:get-arg "-server")
(let* ((run-id (args:get-arg-number "-run-id"))
(tl (launch:setup)))
(case (rmt:transport-mode)
((http)(http-transport:launch))
((tcp)
(debug:print 0 *default-log-port* "INFO: Running using tcp method.")
(if run-id
(tt:start-server tl (dbmod:run-id->dbfname run-id))
(begin
(debug:print 0 *default-log-port* "ERROR: transport mode is tcp - -run-id is required.")
(exit 1))))
(else (debug:print 0 *default-log-port* "ERROR: rmt:transport-mode value not recognised "(rmt:transport-mode))))
(set! *didsomething* #t)))
|
| ︙ | ︙ |
Modified tcp-transportmod.scm from [724c5d0f96] to [4ba3510aa8].
| ︙ | ︙ | |||
142 143 144 145 146 147 148 | ;; ;; NOTE: organise by dbfname, not run-id so we don't need ;; to pull in more modules ;; (define (tt:start-server areapath dbfname handler) ;; is there already a server for this dbfile? Then exit. (let* ((ttdat (make-tt-srv areapath: areapath)) | < | 142 143 144 145 146 147 148 149 150 151 152 153 154 155 |
;;
;; NOTE: organise by dbfname, not run-id so we don't need
;; to pull in more modules
;;
(define (tt:start-server areapath dbfname handler)
;; is there already a server for this dbfile? Then exit.
(let* ((ttdat (make-tt-srv areapath: areapath))
(servers (tt:find-server ttdat dbfname)))
(tt-srv-handler-set! ttdat handler)
(if (null? servers)
(begin
(tt:start-tcp-server ttdat) ;; start the tcp-server which applies handler to incoming data
(tt:keep-running ttdat dbfname))
(begin
|
| ︙ | ︙ | |||
235 236 237 238 239 240 241 |
(servinf (conc servdir"/"host":"port"-"(current-process-id)":"dbfname))
(serv-id (tt:mk-signature areapath))
(clean-proc (lambda ()
(delete-file* servinf))))
(tt-srv-cleanup-proc-set! ttdat clean-proc)
(with-output-to-file servinf
(lambda ()
| | | 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 |
(servinf (conc servdir"/"host":"port"-"(current-process-id)":"dbfname))
(serv-id (tt:mk-signature areapath))
(clean-proc (lambda ()
(delete-file* servinf))))
(tt-srv-cleanup-proc-set! ttdat clean-proc)
(with-output-to-file servinf
(lambda ()
(print "SERVER STARTED: "host":"port" AT "(current-seconds)" server-id: "serv-id" pid: "(current-process-id)" dbfname: "dbfname)))
serv-id)))
;; find valid server
;; get servers listed, last part of name must match :<dbfname>
;; if more than one, wait one second and look again
;; future: ping oldest, if alive remove other :<dbfname> files
;;
|
| ︙ | ︙ |