Megatest

Check-in [31334b02f8]
Login
Overview
Comment:Switch to using ip address instead of host name for rpc
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | archiving
Files: files | file ages | folders
SHA1: 31334b02f8920354aacef9db1660c919af37e14d
User & Date: matt on 2012-02-23 23:44:53
Other Links: branch diff | manifest | tags
Context
2012-02-24
00:02
Corrected typo check-in: 22a0698c7c user: matt tags: archiving
2012-02-23
23:44
Switch to using ip address instead of host name for rpc check-in: 31334b02f8 user: matt tags: archiving
23:14
test-set-log converted to support rpc check-in: 04064e6f49 user: matt tags: archiving
Changes

Modified server.scm from [41b2a60811] to [cc2c615ded].

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)
(import (prefix sqlite3 sqlite3:))

(declare (unit server))

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














|







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 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
     (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)
    (rpc:publish-procedure! 
     'remote:run 
     (lambda (procstr . params)
       (server:autoremote procstr params)))

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







|
|
|
|
>
>
>
|
|







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))
	 (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