10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;; (include "common.scm")
;; (include "megatest-version.scm")
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
(use srfi-1 posix srfi-69 readline ;; regex regex-case srfi-69 apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras)
srfi-18 extras format pkts regex regex-case
(prefix dbi dbi:)
nanomsg)
(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses configf))
|
|
|
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;; (include "common.scm")
;; (include "megatest-version.scm")
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
(use srfi-1 posix srfi-69 readline ;; regex regex-case srfi-69 apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras)
srfi-18 extras format pkts regex regex-case
(prefix dbi dbi:)
nanomsg)
(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses configf))
|
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
|
(write data))))
(define-inline (decode data)
(with-input-from-string
data
(lambda ()
(read))))
;;start a server, returns the connection
;;
(define (start-nn-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 "\"")
(exit 1))
(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))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
|
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
|
(write data))))
(define-inline (decode data)
(with-input-from-string
data
(lambda ()
(read))))
(define (is-port-in-use port-num)
(let* ((ret #f))
(let-values (((inp oup pid)
(process "netstat" (list "-tulpn" ))))
(let loop ((inl (read-line inp)))
(if (not (eof-object? inl))
(begin
(if (string-search (regexp (conc ":" port-num)) inl)
(begin
;(print "Output: " inl)
(set! ret #t))
(loop (read-line inp)))))))
ret))
;;start a server, returns the connection
;;
(define (start-nn-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 "\"")
(exit 1))
(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))
|
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
|
((tlisten)
(if (null? remargs)
(print "ERROR: useage for tlisten is \"mtutil tlisten portnum\"")
(let ((portnum (string->number (car remargs))))
(if (not portnum)
(print "ERROR: the portnumber parameter must be a number, you gave: " (car remargs))
(let* ((rep (start-nn-server portnum))
(mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat))
(script (configf:lookup mtconf "listener" "script")))
(print "Listening on port " portnum " for messages")
(let loop ((instr (nn-recv rep)))
(print "received " instr ", running \"" script " " instr "\"")
(system (conc script " " instr))
(nn-send rep "ok")
(loop (nn-recv rep))))))))
)) ;; the end
;; If HTTP_HOST is defined then we must be in the cgi environment
;; so run stml and exit
;;
|
>
>
|
|
|
|
|
|
|
|
|
|
>
|
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
|
((tlisten)
(if (null? remargs)
(print "ERROR: useage for tlisten is \"mtutil tlisten portnum\"")
(let ((portnum (string->number (car remargs))))
(if (not portnum)
(print "ERROR: the portnumber parameter must be a number, you gave: " (car remargs))
(begin
(if (not (is-port-in-use portnum))
(let* ((rep (start-nn-server portnum))
(mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat))
(script (configf:lookup mtconf "listener" "script")))
(print "Listening on port " po:setrtnum " for messages")
(let loop ((instr (nn-recv rep)))
(print "received " instr ", running \"" script " " instr "\"")
(system (conc script " " instr))
(nn-send rep "ok")
(loop (nn-recv rep))))
(print "ERROR: Port " portnum " already in use. Try another port")))))))
)) ;; the end
;; If HTTP_HOST is defined then we must be in the cgi environment
;; so run stml and exit
;;
|