Index: mtut.scm ================================================================== --- mtut.scm +++ mtut.scm @@ -492,10 +492,12 @@ (with-input-from-string data (lambda () (read)))) +;; moved to portlogger - TODO: remove from here and get from portlogger +;; (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))) Index: portlogger.scm ================================================================== --- portlogger.scm +++ portlogger.scm @@ -17,11 +17,11 @@ ;; along with Megatest. If not, see . ;; (require-extension (srfi 18) extras tcp s11n) -(use sqlite3 srfi-1 posix srfi-69 hostinfo dot-locking z3) +(use sqlite3 srfi-1 posix srfi-69 hostinfo dot-locking z3 regex) (import (prefix sqlite3 sqlite3:)) (declare (unit portlogger)) (declare (uses db)) @@ -80,13 +80,13 @@ ;; (fold-row PROC INIT DATABASE SQL . PARAMETERS) (define (portlogger:take-port db portnum) (let* ((qry1 (sqlite3:prepare db "INSERT INTO ports (port,state) VALUES (?,?);")) (qry2 (sqlite3:prepare db "UPDATE ports SET state=?,update_time=strftime('%s','now') WHERE port=?;")) (qry3 (sqlite3:prepare db "SELECT state FROM ports WHERE port=?;")) - (res (sqlite3:with-transaction - db - (lambda () + (res ;; (sqlite3:with-transaction ;; move the transaction up to the find-port call + ;; db + ;; (lambda () ;; (fold-row (lambda (var curr) (or var curr)) #f db "SELECT var FROM foo WHERE id=100;") (let* ((curr #f) (res #f)) (set! curr (sqlite3:fold-row (lambda (var curr) @@ -100,11 +100,11 @@ ((not-tried) (sqlite3:execute qry1 portnum "taken") 'taken) ((taken) 'already-taken) ((failed) 'failed) (else 'error))) ;; (print "res=" res) - res))))) + res))) ;; )) (sqlite3:finalize! qry1) (sqlite3:finalize! qry2) (sqlite3:finalize! qry3) res)) @@ -124,38 +124,60 @@ #f db "SELECT (port) FROM ports WHERE state='released' LIMIT 1;"))) (define (portlogger:find-port db) - (let* ((lowport (let ((val (configf:lookup *configdat* "server" "lowport"))) - (if (and val - (string->number val)) - (string->number val) - 32768))) - (portnum (or (portlogger:get-prev-used-port db) - (+ lowport ;; top of registered ports is 49152 but lets use ports in the registered range - (random (- 64000 lowport)))))) - (handle-exceptions - exn - (begin - (debug:print 0 *default-log-port* "EXCEPTION: portlogger database probably overloaded or unreadable. If you see this message again remove /tmp/.$USER-portlogger.db") - (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) - (debug:print 5 *default-log-port* "exn=" (condition->list exn)) - (print-call-chain (current-error-port)) - (debug:print 0 *default-log-port* "Continuing anyway.")) - (portlogger:take-port db portnum)) - portnum)) + (let ((lowport (let ((val (configf:lookup *configdat* "server" "lowport"))) + (if (and val + (string->number val)) + (string->number val) + 32768)))) + (sqlite3:with-transaction + db + (lambda () + (let loop ((numtries 0)) + (let* ((portnum (or (portlogger:get-prev-used-port db) + (+ lowport ;; top of registered ports is 49152 but let's use ports in the registered range + (random (- 64000 lowport)))))) + (handle-exceptions + exn + (begin + (debug:print 0 *default-log-port* "EXCEPTION: portlogger database probably overloaded or unreadable. If you see this message again remove /tmp/.$USER-portlogger.db") + (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) + (debug:print 5 *default-log-port* "exn=" (condition->list exn)) + (print-call-chain (current-error-port)) + (debug:print 0 *default-log-port* "Continuing anyway.")) + (portlogger:take-port db portnum) ;; always "take the port" + (if (portlogger:is-port-in-use portnum) + portnum + (loop (add1 numtries)))))))))) ;; set port to "released", "failed" etc. ;; (define (portlogger:set-port db portnum value) (sqlite3:execute db "UPDATE ports SET state=?,update_time=strftime('%s','now') WHERE port=?;" value portnum)) +;; release port +(define (portlogger:release-port db portnum) + (sqlite3:execute db "UPDATE ports SET state=?,update_time=strftime('%s','now') WHERE port=?;" "released" portnum)) + ;; set port to failed (attempted to take but got error) ;; (define (portlogger:set-failed db portnum) (sqlite3:execute db "UPDATE ports SET state='failed',fail_count=fail_count+1,update_time=strftime('%s','now') WHERE port=?;" portnum)) + +;; pulled from mtut - TODO: remove from mtut +;; +(define (portlogger:is-port-in-use port-num) + (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) + #t + (loop (read-line inp)))))))) ;;====================================================================== ;; MAIN ;;======================================================================