Megatest

(define-inline (decode data)
  (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)))
        (if (not (eof-object? inl))
            (begin 

;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

(require-extension (srfi 18) extras tcp s11n)

(use sqlite3 srfi-1 posix srfi-69 hostinfo dot-locking z3 regex)
(import (prefix sqlite3 sqlite3:))

(declare (unit portlogger))
(declare (uses db))

;; lsof -i

       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=?,update_time=strftime('%s','now') WHERE port=?;"))
	 (qry3 (sqlite3:prepare db "SELECT state FROM ports WHERE port=?;"))
	 (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)
				  (or curr var curr))
				"not-tried"
				qry3
				portnum))
		    ;; (print "curr=" curr)
		    (set! res (case (string->symbol curr)
				((released)  (sqlite3:execute qry2 "taken" portnum) 'taken)
				((not-tried) (sqlite3:execute qry1 portnum "taken") 'taken)
				((taken)                                            'already-taken)
				((failed)                                           'failed)
				(else                                               'error)))
		    ;; (print "res=" res)
		    res))) ;; ))
    (sqlite3:finalize! qry1)
    (sqlite3:finalize! qry2)
    (sqlite3:finalize! qry3)
    res))

(define (portlogger:get-prev-used-port db)
  (handle-exceptions

     (lambda (var curr)
       (or curr var curr))
     #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))))
    (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
;;======================================================================

(define (portlogger:main . args)
  (let* ((dbfname (conc "/tmp/." (current-user-name) "-portlogger.db"))