File: replica

package info (click to toggle)
picolisp 18.12-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 4,988 kB
  • sloc: ansic: 14,390; lisp: 1,589; makefile: 431; sh: 14
file content (55 lines) | stat: -rwxr-xr-x 1,361 bytes parent folder | download
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
#!/usr/bin/picolisp /usr/lib/picolisp/lib.l
# 15dec18abu
# Use: bin/replica <port|num> <keyFile> <journal> <dbFile> <blob/app/> [dbs1 ..]
#    : bin/ssl <host> 443 '<port|name>/!replica' <keyFile> <journal> <blob/app/> 20 [60]

(argv *Arg1 *KeyFile *Journal *Pool *Blob . *Dbs)
(unless (info *KeyFile)
   (bye) )

(pool *Pool (mapcar format *Dbs) *Journal)
(loop
   (tell 'bye 2)
   (NIL (lock))
   (wait 200) )

(load "@lib/misc.l" "@lib/http.l")

(allow "!replica")

(setq
   *Arg1 (format *Arg1)
   *Port (or (format (sys "PORT")) *Arg1)
   *SSLKey (in *KeyFile (line T))
   *Replica (tmp 'replica) )

(de replicate (N)
   (and
      (out *Replica (echo N))
      (= N (car (info *Replica)))
      (= "T" (prin (peek)))
      (flush)
      (char)
      (eof) ) )

(de replica ()
   (when (= (line T) *SSLKey)
      (let? X (line T)
         (if (format X)
            (when (replicate @)                    # Journal
               (protect (journal *Replica)) )
            (let Blob (pack *Blob X)               # Blob
               (call 'mkdir "-p" (dirname Blob))
               (and
                  (format (line T))
                  (replicate @)
                  (protect (call "mv" *Replica Blob)) ) ) ) ) ) )

(retire *Arg1)

# Non-forking server
(let P (port *Port)
   (loop
      (let S (listen P)
         (http S)
         (close S) ) ) )