DELETED common.scm
Index: common.scm
==================================================================
--- common.scm
+++ /dev/null
@@ -1,46 +0,0 @@
-;;======================================================================
-;; Copyright 2006-2012, Matthew Welland.
-;;
-;; This file is part of Megatest.
-;;
-;; Megatest is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-;;
-;; Megatest is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with Megatest. If not, see .
-
-;;======================================================================
-
-;; (use srfi-1 data-structures posix regex-case (prefix base64 base64:)
-;; format dot-locking csv-xml z3 udp ;; sql-de-lite
-;; hostinfo md5 message-digest typed-records directory-utils stack
-;; matchable regex posix (srfi 18) extras ;; tcp
-;; (prefix nanomsg nmsg:)
-;; (prefix sqlite3 sqlite3:)
-;; pkts (prefix dbi dbi:)
-;; )
-;;
-;; (declare (unit common))
-;; ;; (declare (uses commonmod))
-;; ;; (import commonmod)
-;;
-;; (include "common_records.scm")
-
-
-;; (require-library margs)
-;; (include "margs.scm")
-
-;; (define old-exit exit)
-;;
-;; (define (exit . code)
-;; (if (null? code)
-;; (old-exit)
-;; (old-exit code)))
-
Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -169,13 +169,13 @@
;; (include "key_records.scm")
;; (include "db_records.scm")
(include "run_records.scm")
;; (include "test_records.scm")
-(include "common.scm")
+;; (include "common.scm")
(include "db.scm")
-(include "server.scm")
+;; (include "server.scm")
(include "tests.scm")
(include "genexample.scm")
(include "tdb.scm")
(include "env.scm")
(include "diff-report.scm")
Index: rmtmod.scm
==================================================================
--- rmtmod.scm
+++ rmtmod.scm
@@ -62,11 +62,11 @@
;; http-client
;; intarweb
matchable
md5
message-digest
- nanomsg
+ nng ;; nanomsg
(prefix base64 base64:)
(prefix sqlite3 sqlite3:)
regex
s11n
;; spiffy
@@ -1622,21 +1622,21 @@
(servdat-port-set! *server-info* port)
(servdat-status-set! *server-info* 'trying-port)
(servdat-trynum-set! *server-info* (+ (servdat-trynum *server-info*) 1)))
(set! *server-info* (make-servdat host: ipaddrstr port: port)))
(let* ((rep (rmt:try-start-server ipaddrstr port)))
- (let loop ((instr (nn-recv rep)))
+ (let loop ((instr (nng-recv rep)))
(let* ((data (string->sexpr instr))
(res (case data
((quit) 'quit)
(else (api:process-request *dbstruct-db* data))))
(resdat (sexpr->string res)))
(if (not (eq? res 'quit))
(begin
(set! *db-last-access* (current-seconds))
- (nn-send rep resdat)
- (loop (nn-recv rep)))))))
+ (nng-send rep resdat)
+ (loop (nng-recv rep)))))))
(debug:print-info 0 *default-log-port* "After server, should never see this")
;; server exit stuff here
(let* ((portnum (servdat-port *server-info*)))
(portlogger:open-run-close portlogger:set-port portnum "released")
(rmt:server-shutdown)
@@ -1689,11 +1689,13 @@
host: ipaddrstr
port: portnum)))
(servdat-status-set! *server-info* 'starting)
(servdat-port-set! *server-info* portnum)
(if (not (servdat-rep *server-info*))
- (servdat-rep-set! *server-info* (nn-socket 'rep)))
+ (let ((rep (make-rep-socket)))
+ (servdat-rep-set! *server-info* rep)
+ (socket-set! rep 'nng/recvtimeo 2000)))
(let* ((rep (servdat-rep *server-info*)))
(debug:print 0 *default-log-port* "INFO: Trying to start server on " ipaddrstr ":" portnum)
(handle-exceptions
exn
(begin
@@ -1708,11 +1710,11 @@
;; (thread-sleep! 0.1)
(rmt:try-start-server ipaddrstr
(portlogger:open-run-close portlogger:find-port)))
(begin
(print "ERROR: Tried and tried but could not start the server, stopping at port "portnum))))
- (nn-bind rep (conc "tcp://*:" portnum))
+ (nng-listen rep (conc "tcp://*:" portnum))
rep)))))
;;======================================================================
;; S E R V E R U T I L I T I E S
;;======================================================================
@@ -2285,42 +2287,44 @@
ret))
;;start a server, returns the connection
;;
(define (start-nn-server portnum )
- (let ((rep (nn-socket 'rep)))
+ (let ((rep (make-rep-socket))) ;; (nn-socket 'rep)))
+ (socket-set! rep 'nng/recvtimeo 2000)
(handle-exceptions
exn
(let ((emsg ((condition-property-accessor 'exn 'message) exn)))
(print "ERROR: Failed to start server \"" emsg "\"")
(exit 1))
- (nn-bind rep (conc "tcp://*:" portnum)))
+ (nng-dial #;nn-bind rep (conc "tcp://*:" portnum)))
rep))
;; open connection to server, send message, close connection
;;
(define (open-send-close-nn host-port msg #!key (timeout 3) ) ;; default timeout is 3 seconds
- (let ((req (nn-socket 'req))
+ (let ((req (make-req-socket 'req))
(uri (conc "tcp://" host-port))
(res #f)
;; (contacts (alist-ref 'contact attrib))
;; (mode (alist-ref 'mode attrib))
- )
+ )
+ (socket-set! req 'nng/recvtimeo 2000)
(handle-exceptions
exn
(let ((emsg ((condition-property-accessor 'exn 'message) exn)))
;; Send notification
(debug:print 0 *default-log-port* "ERROR: Failed to connect / send to " uri " message was \"" emsg "\"" )
#f)
- (nn-connect req uri)
+ (nng-dial req uri)
;; (print "Connected to the server " )
- (nn-send req msg)
+ (nng-send req msg)
;; (print "Request Sent")
(let* ((th1 (make-thread (lambda ()
- (let ((resp (nn-recv req)))
- (nn-close req)
+ (let ((resp (nng-recv req)))
+ (nng-close! req)
(set! res (if (equal? resp "ok")
#t
#f))))
"recv thread"))
(th2 (make-thread (lambda ()
@@ -2331,11 +2335,11 @@
(thread-start! th2)
(thread-join! th1)
res))))
(define (open-send-receive-nn host-port msg #!key (timeout 3) ) ;; default timeout is 3 seconds
- (let ((req (nn-socket 'req))
+ (let ((req (make-req-socket))
(uri (conc "tcp://" host-port))
(res #f)
;; (contacts (alist-ref 'contact attrib))
;; (mode (alist-ref 'mode attrib))
)
@@ -2343,19 +2347,19 @@
exn
(let ((emsg ((condition-property-accessor 'exn 'message) exn)))
;; Send notification
(debug:print 0 *default-log-port* "ERROR: Failed to connect / send to " uri " message was \"" emsg "\", exn=" exn)
#f)
- (nn-connect req uri)
+ (nng-dial req uri)
;; (print "Connected to the server " )
- (nn-send req msg)
+ (nng-send req msg)
;; (print "Request Sent")
;; receive code here
;;(print (nn-recv req))
(let* ((th1 (make-thread (lambda ()
- (let ((resp (nn-recv req)))
- (nn-close req)
+ (let ((resp (nng-recv req)))
+ (nng-close! req)
(print resp)
(set! res resp)))
"recv thread"))
(th2 (make-thread (lambda ()
(thread-sleep! timeout)
DELETED server.scm
Index: server.scm
==================================================================
--- server.scm
+++ /dev/null
@@ -1,51 +0,0 @@
-;; Copyright 2006-2017, Matthew Welland.
-;;
-;; This file is part of Megatest.
-;;
-;; Megatest is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-;;
-;; Megatest is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with Megatest. If not, see .
-;;
-
-;; (require-extension (srfi 18) extras tcp s11n)
-;;
-;; (use srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest
-;; directory-utils posix-extras matchable)
-;;
-;; (use spiffy uri-common intarweb http-client spiffy-request-vars)
-;;
-;; (declare (unit server))
-;;
-;; (declare (uses common))
-;; (declare (uses db))
-;; (declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
-;; ;; (declare (uses synchash))
-;; (declare (uses http-transport))
-;; ;;(declare (uses rpc-transport))
-;; (declare (uses launch))
-;; ;; (declare (uses daemon))
-;;
-;; (include "common_records.scm")
-;; (include "db_records.scm")
-
-;;======================================================================
-;; P K T S S T U F F
-;;======================================================================
-
-;; ???
-
-;;======================================================================
-;; P K T S S T U F F
-;;======================================================================
-
-;; ???
-