Overview
| Comment: | Added basic server pkt stuff |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.6584-ck5 |
| Files: | files | file ages | folders |
| SHA1: |
51b1485d60f7b286ad3a5cfe5850a28f |
| User & Date: | matt on 2021-04-19 23:18:50 |
| Other Links: | branch diff | manifest | tags |
Context
|
2021-04-19
| ||
| 23:42 | Ensured that servermod is available from the repl check-in: 80cccdf80e user: matt tags: v1.6584-ck5 | |
| 23:18 | Added basic server pkt stuff check-in: 51b1485d60 user: matt tags: v1.6584-ck5 | |
|
2021-04-18
| ||
| 23:26 | wip check-in: 641ecb4b57 user: matt tags: v1.6584-ck5 | |
Changes
Deleted bin/.11/lib/libpangox-1.0.so version [d55c756a93].
cannot compute difference between binary files
Deleted bin/.11/lib/libpangox-1.0.so.0 version [d55c756a93].
cannot compute difference between binary files
Deleted bin/.11/lib/libxcb-xlib.so.0 version [b7cbe8e250].
cannot compute difference between binary files
Deleted pktsmod.scm version [4f496b5684].
|
| < < < < < < < < < < < < < < < < < < < < < < < |
Modified servermod.scm from [847bcc149f] to [e889c966f5].
| ︙ | ︙ | |||
19 20 21 22 23 24 25 26 27 28 29 30 31 32 | ;;====================================================================== (declare (unit servermod)) (declare (uses commonmod)) (declare (uses debugprint)) (declare (uses configfmod)) (declare (uses http-transportmod)) (module servermod * (import scheme chicken.base chicken.string | > | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | ;;====================================================================== (declare (unit servermod)) (declare (uses commonmod)) (declare (uses debugprint)) (declare (uses configfmod)) (declare (uses http-transportmod)) (declare (uses pkts)) (module servermod * (import scheme chicken.base chicken.string |
| ︙ | ︙ | |||
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 |
srfi-18
srfi-69
commonmod
debugprint
configfmod
http-transportmod
)
(define (server:make-server-url hostport)
(if (not hostport)
#f
(conc "http://" (car hostport) ":" (cadr hostport))))
;;======================================================================
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 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 |
srfi-18
srfi-69
commonmod
debugprint
configfmod
http-transportmod
pkts
)
;;======================================================================
;; NEW SERVER METHOD
;;======================================================================
(define *srvpktspec*
`((server (host . h)
(port . p)
(servkey . k)
(pid . i)
(ipaddr . a)
(dbpath . d))))
(define (register-server pkts-dir pkt-spec host port servkey ipaddr dbpath)
(let* ((pkt-dat `((host . ,host)
(port . ,port)
(servkey . ,servkey)
(pid . ,(current-process-id))
(ipaddr . ,ipaddr)
(dbpath . ,dbpath))))
(write-alist->pkt
pkts-dir
pkt-dat
pktspec: pkt-spec
ptype: 'server)))
;; given a pkts dir read
;;
(define (get-all-server-pkts pktsdir-in pktspec)
(let* ((pktsdir (if (file-exists? pktsdir-in)
pktsdir-in
(begin
(create-directory pktsdir-in #t)
pktsdir-in)))
(all-pkt-files (glob (conc pktsdir "/*.pkt"))))
(map (lambda (pkt-file)
(read-pkt->alist pkt-file pktspec: pktspec))
all-pkt-files)))
(define (server-address srv-pkt)
(conc (alist-ref 'host srv-pkt) ":"
(alist-ref 'port srv-pkt)))
(define (server-ready? server-address)
;; ping the server and ask it
;; if it ready
#f)
;; from the pkts return servers associated with dbpath
;; NOTE: Only one can be alive - have to check on each
;; in the list of pkts returned
;;
(define (get-viable-servers serv-pkts dbpath)
(let loop ((tail serv-pkts)
(res '()))
(if (null? tail)
res ;; NOTE: sort by age so oldest is considered first
(let* ((spkt (car tail)))
(loop (cdr tail)
(if (equal? dbpath (alist-ref 'dbpath spkt))
(cons spkt res)
res))))))
;; from viable servers get one that is alive and ready
;;
(define (get-the-server serv-pkts dbpath)
(let loop ((tail serv-pkts))
(if (null? tail)
#f
(let* ((spkt (car tail))
(addr (server-address spkt)))
(if (server-ready? addr)
spkt
(loop (cdr tail)))))))
;;======================================================================
;; END NEW SERVER METHOD
;;======================================================================
(define (server:make-server-url hostport)
(if (not hostport)
#f
(conc "http://" (car hostport) ":" (cadr hostport))))
;;======================================================================
|
| ︙ | ︙ |