bokbok
Check-in [44dd02f4c3]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Started documentation
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 44dd02f4c3b15a88c4bb3b4898ffe8b76bee8e44
User & Date: alaric 2017-12-28 18:03:57
Context
2019-11-11
10:44
Notes check-in: f291b9a6bd user: alaric tags: trunk
2017-12-28
21:12
Added DOWNLOAD.wiki check-in: 410f39f189 user: alaric tags: trunk
18:03
Started documentation check-in: 44dd02f4c3 user: alaric tags: trunk
17:44
Sorted out address representation properly check-in: 38a1436a2f user: alaric tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added README.wiki.





































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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
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
<h1>Introduction</h1>

Bokbok is a toolkit for exposing and consuming APIs between processes.

It supports:

  *  TCP or UNIX-domain sockets
  *  Optional encryption and authentication
  *  Multithreading over a single connection: multiple threads may
     make requests via the same connection, and multiple request handlers can be
     running at once in their own threads.
  *  Connections are symmetrical once established: either side may
     invoke the other side's API at any time, "client" and "server"
     are just a matter of who sat passively waiting for a connection
     and who initiated it.

<h1>Usage</h1>

<pre>$ chicken-install bokbok</pre>

<h2>As a client</h2>

<pre>(use bokbok)

;; Called if server sends us a callback request
(define (request-handler con request)
  (match request
   (("callback" num)
     (printf "Callback received: ~s\n" num))
   (else (error "Unrecognised callback"))))

;; Called if server closes the connection
(define (close-handler con)
  (void))

(define con (open-connection '(tcp "myserver" 12345)
             "myuser" (passphrase->key "mypassphrase")
             request-handler close-handler))

(printf "Response is ~s\n" (request! con '("ping" "12345")))

(printf "Response is ~s\n" (request! con '("asynch")))

;; Wait for asynch responses to all arrive
(thread-sleep! 10)

(close-connection! con)</pre>

<h2>As a server</h2>

<pre>(use bokbok)
(use matchable)

(define *server* #f)

(define (user->key username)
  (match username
   ("myuser" (passphrase->key "mypassphrase"))
   (else #f)))

(define (open-handler con)
  (printf "CONNECTION from ~a@~s\n"
    (connection-user con)
    (connection-addr con))
  (void))

(define (request-handler con request)
  (match request
    (("ping" string)
     (list "pong" string))
    (("asynch")
     (thread-start!
       (make-thread
         (lambda ()
           (request! con '("callback" "1"))
           (thread-sleep! 1)
           (request! con '("callback" "2"))
           (thread-sleep! 1)
           (request! con '("callback" "3"))
           (thread-sleep! 1)
           (request! con '("callback" "4")))))
     ;; Return this while the callback thread runs in the background
     (list "ok"))
    (("shutdown-server!")
     (stop-server! *server*))
    (else (error "Unknown request" request))
  ))

(define (close-handler con)
  (printf "DISCONNECTION from ~a@~s\n"
    (connection-user con)
    (connection-addr con))
  (void))

(set! *server* (start-server '(tcp #f 12345) 10 user->key
   open-handler request-handler close-handler)

(wait-until-0server-stopped server)</pre>

Changes to bokbok-demo.scm.

21
22
23
24
25
26
27








28
29
30
31
32
33
34

  (match request
         (("error")
          (error "Error raised"))
         (("callback")
          (let ((response
                 (request! con '("called you back"))))








            (list "did it" (sprintf "~s" response))))
         (("kill")
          (if *server*
              (begin
                (stop-server! *server*)
                (list "ok"))
              (error "I'm not a server")))







>
>
>
>
>
>
>
>







21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

  (match request
         (("error")
          (error "Error raised"))
         (("callback")
          (let ((response
                 (request! con '("called you back"))))
            (thread-start!
             (make-thread
              (lambda ()
                (request! con '("callback" "1"))
                (thread-sleep! 1)
                (request! con '("callback" "2"))
                (thread-sleep! 1)
                (request! con '("callback" "3")))))
            (list "did it" (sprintf "~s" response))))
         (("kill")
          (if *server*
              (begin
                (stop-server! *server*)
                (list "ok"))
              (error "I'm not a server")))
43
44
45
46
47
48
49

50
51
52
53
54
55
56
(define (run-client! con)
  (expect '(ok ("echo" "hello"))
          (request! con '("hello")))
  (expect '(error ("\"Error raised\" in (#f)"))
          (request! con '("error")))
  (expect '(ok ("did it"  "(ok (\"echo\" \"called you back\"))"))
          (request! con '("callback")))

#;  (expect '(ok ("ok"))
          (request! con '("kill")))
  (close-connection! con))

(define (run-server! server)
  (set! *server* server)
  (printf "Running server...\n")







>







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
(define (run-client! con)
  (expect '(ok ("echo" "hello"))
          (request! con '("hello")))
  (expect '(error ("\"Error raised\" in (#f)"))
          (request! con '("error")))
  (expect '(ok ("did it"  "(ok (\"echo\" \"called you back\"))"))
          (request! con '("callback")))
  (thread-sleep! 10)
#;  (expect '(ok ("ok"))
          (request! con '("kill")))
  (close-connection! con))

(define (run-server! server)
  (set! *server* server)
  (printf "Running server...\n")

Changes to bokbok.scm.

412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
                            (parameterize
                             ((socket-send-buffer-size 4096)
                              (socket-send-size 16384))
                             (socket-i/o-ports cs))
                            (let* ((peer (socket-peer-name cs))
                                   (peer-addr (if tcp?
                                                  (list 'tcp (sockaddr-address peer) (sockaddr-port peer))
                                                  '(unix (sockaddr-path peer)))))
                              (debug "Handshake thread started for ~s" peer-addr)
                              (if user->key
                                  ;; Encrypted connection
                                  (let* ((user-name (read-packet! input))
                                         (encrypted-session-key (read-packet! input)))
                                    (if (and (not (eof-object? user-name))
                                             (not (eof-object? encrypted-session-key)))







|







412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
                            (parameterize
                             ((socket-send-buffer-size 4096)
                              (socket-send-size 16384))
                             (socket-i/o-ports cs))
                            (let* ((peer (socket-peer-name cs))
                                   (peer-addr (if tcp?
                                                  (list 'tcp (sockaddr-address peer) (sockaddr-port peer))
                                                  (list 'unix (sockaddr-path peer)))))
                              (debug "Handshake thread started for ~s" peer-addr)
                              (if user->key
                                  ;; Encrypted connection
                                  (let* ((user-name (read-packet! input))
                                         (encrypted-session-key (read-packet! input)))
                                    (if (and (not (eof-object? user-name))
                                             (not (eof-object? encrypted-session-key)))