Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -7,11 +7,11 @@ db.scm keys.scm margs.scm megatest-version.scm \ process.scm runs.scm tasks.scm tests.scm genexample.scm \ http-transport.scm filedb.scm \ client.scm gutils.scm synchash.scm daemon.scm mt.scm dcommon.scm \ tree.scm ezsteps.scm lock-queue.scm sdb.scm \ - rmt.scm api.scm tdb.scm + rmt.scm api.scm tdb.scm portlogger.scm # Eggs to install (straightforward ones) EGGS=matchable readline apropos base64 regex-literals format regex-case test coops trace csv \ dot-locking posix-utils posix-extras directory-utils hostinfo tcp-server rpc csv-xml fmt \ json md5 awful http-client spiffy uri-common intarweb spiffy-request-vars \ Index: http-transport.scm ================================================================== --- http-transport.scm +++ http-transport.scm @@ -25,10 +25,11 @@ (declare (uses db)) (declare (uses tests)) (declare (uses tasks)) ;; tasks are where stuff is maintained about what is running. (declare (uses server)) (declare (uses daemon)) +(declare (uses portlogger)) (include "common_records.scm") (include "db_records.scm") (define (http-transport:make-server-url hostport) @@ -138,10 +139,11 @@ exn (begin (print-error-message exn) (if (< portnum 90000) (begin + (portlogger:open-run-close portlogger:set-failed portnum) (debug:print 0 "WARNING: failed to start on portnum: " portnum ", trying next port") (thread-sleep! 0.1) ;; get_next_port goes here @@ -148,22 +150,28 @@ (http-transport:try-start-server run-id ipaddrstr (+ portnum 1) server-id)) (begin (open-run-close tasks:server-force-clean-run-record tasks:open-db run-id ipaddrstr portnum " http-transport:try-start-server") (print "ERROR: Tried and tried but could not start the server")))) ;; any error in following steps will result in a retry - (set! *server-info* (list ipaddrstr portnum)) - (open-run-close tasks:server-set-interface-port - tasks:open-db - server-id - ipaddrstr portnum) - (debug:print 1 "INFO: Trying to start server on " ipaddrstr ":" portnum) - ;; This starts the spiffy server - ;; NEED WAY TO SET IP TO #f TO BIND ALL - ;; (start-server bind-address: ipaddrstr port: portnum) - (start-server port: portnum) - (open-run-close tasks:server-force-clean-run-record tasks:open-db run-id ipaddrstr portnum " http-transport:try-start-server") - (debug:print 1 "INFO: server has been stopped"))) + (case (portlogger:open-run-close portlogger:take-port portnum) + ((taken) + (set! *server-info* (list ipaddrstr portnum)) + (open-run-close tasks:server-set-interface-port + tasks:open-db + server-id + ipaddrstr portnum) + (debug:print 1 "INFO: Trying to start server on " ipaddrstr ":" portnum) + ;; This starts the spiffy server + ;; NEED WAY TO SET IP TO #f TO BIND ALL + ;; (start-server bind-address: ipaddrstr port: portnum) + (start-server port: portnum) + (portlogger:open-run-close portlogger:set-port portnum "released") + (open-run-close tasks:server-force-clean-run-record tasks:open-db run-id ipaddrstr portnum " http-transport:try-start-server") + (debug:print 1 "INFO: server has been stopped")) + (else + (http-transport:try-start-server run-id ipaddrstr (+ portnum 1) server-id))) + (portlogger:open-run-close portlogger:set-port portnum "released"))) ;;====================================================================== ;; S E R V E R U T I L I T I E S ;;====================================================================== @@ -395,15 +403,16 @@ ;; (debug:print 11 "last-access=" last-access ", server-timeout=" server-timeout) ;; ;; no_traffic, no running tests, if server 0, no running servers ;; (if (and *server-run* - (or (> (db:get-count-tests-running *inmemdb* run-id) 0) + (or (> (+ last-access server-timeout) + (current-seconds)) (and (eq? run-id 0) (> (tasks:num-servers-non-zero-running tdb) 0)) - (> (+ last-access server-timeout) - (current-seconds)))) + (> (db:get-count-tests-running *inmemdb* run-id) 0) + )) (begin (debug:print-info 0 "Server continuing, seconds since last db access: " (- (current-seconds) last-access)) ;; ;; Consider implementing some smarts here to re-insert the record or kill self is ;; the db indicates so @@ -419,10 +428,11 @@ (if *inmemdb* (db:sync-touched *inmemdb* *run-id* force-sync: #t)) ;; ;; start_shutdown ;; ( tasks:server-set-state! tdb server-id "shutting-down") + (portlogger:open-run-close portlogger:set-port port "released") (thread-sleep! 5) (debug:print-info 0 "Max cached queries was " *max-cache-size*) (debug:print-info 0 "Number of cached writes " *number-of-writes*) (debug:print-info 0 "Average cached write time " (if (eq? *number-of-writes* 0) Index: portlogger.scm ================================================================== --- portlogger.scm +++ portlogger.scm @@ -11,10 +11,12 @@ (require-extension (srfi 18) extras tcp s11n) (use sqlite3 srfi-1 posix srfi-69 hostinfo) (import (prefix sqlite3 sqlite3:)) +(declare (unit portlogger)) + ;; lsof -i (define (portlogger:open-db fname) (let* ((exists (file-exists? fname)) @@ -29,10 +31,19 @@ "CREATE TABLE ports ( port INTEGER PRIMARY KEY, state TEXT DEFAULT 'not-used', fail_count INTEGER DEFAULT 0);")) db)) + +(define (portlogger:open-run-close proc . params) + (handle-exceptions + exn + (print "ERROR: portlogger:open-run-close failed. " proc " " params) + (let* ((db (portlogger:open-db (conc "/tmp/." (current-user-name) "-portlogger.db"))) + (res (apply proc db params))) + (sqlite3:finalize! db) + res))) ;; (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=? WHERE port=?;")) @@ -78,11 +89,11 @@ ;;====================================================================== (define (portlogger:main . args) - (let* ((db (portlogger:open-db (conc "/tmp/." (current-user-name)))) + (let* ((db (portlogger:open-db (conc "/tmp/." (current-user-name) "-portlogger.db"))) (numargs (length args)) (result (cond ((> numargs 1) ;; most commands (case (string->symbol (car args)) ;; commands with two or more params ((take)(portlogger:take-port db (string->number (cadr args)))) @@ -92,6 +103,6 @@ (caddr args)) ((failed)(portlogger:set-failed db (string->number (cadr args))) 'failed)))))) (sqlite3:finalize! db) result)) -(print (apply portlogger:main (cdr (argv)))) +;; (print (apply portlogger:main (cdr (argv))))