;; 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 <http://www.gnu.org/licenses/>.
;;======================================================================
;; Support routines for nmsg usage.
;; This should be reusable, non-megatest specific stuff
;;======================================================================
(declare (unit nmsg-transport))
(module
nmsg-transport
(
nmsg:start-server
nmsg:open-send-close
nmsg:open-send-receive
nmsg:recv
nmsg:send
nmsg:close
)
(import scheme posix chicken data-structures ports)
(use nanomsg srfi-18)
;;start a server, returns the connection
;;
(define (nmsg:start-server portnum)
(let ((rep (nn-socket 'rep)))
(handle-exceptions
exn
(let ((emsg ((condition-property-accessor 'exn 'message) exn)))
(print "ERROR: Failed to start server \"" emsg "\"")
#f)
(nn-bind rep (conc "tcp://*:" portnum)))
rep))
;; open connection to server, send message, close connection
;;
;; to take an action on failure use proc which is called with the error info
;; (proc exn errormsg)
;;
;; returns the response or #f if no response within timeout
;;
(define (nmsg:open-send-close host-port msg #!key (timeout 3)(proc #f)) ;; default timeout is 3 seconds
(let ((req (nn-socket 'req))
(uri (conc "tcp://" host-port))
(res #f))
(handle-exceptions
exn
(let ((emsg ((condition-property-accessor 'exn 'message) exn)))
;; call proc on fail
(if proc (proc exn emsg))
#f)
(nn-connect req uri)
(print "Connected to the server " )
(nn-send req msg)
(print "Request Sent")
(let* ((th1 (make-thread (lambda ()
(let ((resp (nn-recv req)))
(nn-close req)
(set! res resp)))
"recv thread"))
(th2 (make-thread (lambda ()
(thread-sleep! timeout)
(thread-terminate! th1))
"timer thread")))
(thread-start! th1)
(thread-start! th2)
(thread-join! th1)
res))))
;; default timeout is 3 seconds
;;
(define (nmsg:open-send-receive host-port msg #!key (timeout 3)(proc #f))
(let ((req (nn-socket 'req))
(uri (conc "tcp://" host-port))
(res #f))
(handle-exceptions
exn
(let ((emsg ((condition-property-accessor 'exn 'message) exn)))
;; take action on fail
(if proc (proc exn emsg))
#f)
(nn-connect req uri)
(nn-send req msg)
(let* ((th1 (make-thread (lambda ()
(let ((resp (nn-recv req)))
(nn-close req)
(print resp)
(set! res resp)))
"recv thread"))
(th2 (make-thread (lambda ()
(thread-sleep! timeout)
(thread-terminate! th1))
"timer thread")))
(thread-start! th1)
(thread-start! th2)
(thread-join! th1)
res))))
(define nmsg:close nn-close)
(define nmsg:recv nn-recv)
(define nmsg:send nn-send)
)