Megatest

Diff
Login

Differences From Artifact [41b2a60811]:

To Artifact [cc2c615ded]:


1
2
3
4
5
6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21
1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21













-
+








;; Copyright 2006-2011, 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 rpc)
(import (prefix rpc rpc:))

(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 hostinfo)
(import (prefix sqlite3 sqlite3:))

(declare (unit server))

(declare (uses common))
(declare (uses db))

31
32
33
34
35
36
37
38
39
40
41
42
43









44
45
46
47
48
49
50
31
32
33
34
35
36
37






38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53







-
-
-
-
-
-
+
+
+
+
+
+
+
+
+







     (apply (eval (string->symbol proc)) params))
   (if *runremote*
       (apply (eval (string->symbol (conc "remote:" procstr))) params)
       (eval (string->symbol procstr) params))))

(define (server:start db)
  (debug:print 0 "Attempting to start the server ...")
  (let* ((rpc:listener (server:find-free-port-and-open (rpc:default-server-port)))
	 (th1          (make-thread
			(cute (rpc:make-server rpc:listener) "rpc:server")
			'rpc:server))
	 (host:port    (conc (get-host-name) ":" (rpc:default-server-port))))
    (db:set-var db "SERVER" host:port)
  (let* ((rpc:listener   (server:find-free-port-and-open (rpc:default-server-port)))
	 (th1            (make-thread
			  (cute (rpc:make-server rpc:listener) "rpc:server")
			  'rpc:server))
	 (hostname       (get-host-name))
	 (ipaddr         (hostname->ip hostname))
	 (ipaddrstr      (string-intersperse (map number->string (u8vector->list ipaddr)) "."))
	 (ipaddrstr:port (conc ipaddrstr ":" (rpc:default-server-port))))
    (db:set-var db "SERVER" ipaddrstr:port)
    (rpc:publish-procedure! 
     'remote:run 
     (lambda (procstr . params)
       (server:autoremote procstr params)))

    ;;======================================================================
    ;; db specials here