Megatest

# removed from MSRCFILES: ftail.scm
# module source files

MSRCFILES = dbmod.scm rmtmod.scm commonmod.scm apimod.scm		\
archivemod.scm clientmod.scm envmod.scm ezstepsmod.scm itemsmod.scm	\
keysmod.scm launchmod.scm odsmod.scm processmod.scm runconfigmod.scm	\
runsmod.scm servermod.scm subrunmod.scm tasksmod.scm testsmod.scm	\
pkts.scm mtargs.scm mtconfigf.scm ducttape-lib.scm megamod.scm
pkts.scm mtargs.scm mtconfigf.scm ducttape-lib.scm ulex.scm		\
megamod.scm

GMSRCFILES = dcommonmod.scm vgmod.scm treemod.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	\

# mofiles/ducttape-lib.o : ducttape-lib.scm ducttape/*scm
#	csc -I ducttape -J -c ducttape-lib.scm -o mofiles/ducttape-lib.o

mofiles/%.o %.import.scm : %.scm
	mkdir -p mofiles
	csc $(CSCOPTS) -J -c $< -o mofiles/$*.o
	touch $*.import.scm # ensure it is touched after the .o is made

# a.import.o : a.import.scm a.o
# csc -unit a.import -c a.import.scm -o $*.o

ADTLSCR=mt_laststep mt_runstep mt_ezstep
HELPERS=$(addprefix $(PREFIX)/bin/,$(ADTLSCR))
DEPLOYHELPERS=$(addprefix deploytarg/,$(ADTLSCR))

dcommon.o : run_records.scm migrate-fix.scm

# special include based modules
mofiles/pkts.o : pkts/pkts.scm
mofiles/mtargs.o : mtargs/mtargs.scm
mofiles/mtconfigf.o : mtconfigf/mtconfigf.scm
mofiles/ulex.o : ulex/ulex.scm
# mofile/ducttape-lib.o : ducttape/ducttape-lib.scm

# Temporary while transitioning to new routine
# runs.o : run-tests-queue-classic.scm  run-tests-queue-new.scm

# for the modularized stuff

mofiles/commonmod.o : megatest-fossil-hash.scm
mofiles/dbmod.o     : mofiles/commonmod.o mofiles/keysmod.o mofiles/tasksmod.o mofiles/odsmod.o
mofiles/dbmod.o     : mofiles/commonmod.o mofiles/keysmod.o \
                      mofiles/tasksmod.o mofiles/odsmod.o
mofiles/commonmod.o : mofiles/processmod.o
mofiles/rmtmod.o    : mofiles/dbmod.o mofiles/commonmod.o mofiles/apimod.o
mofiles/rmtmod.o    : mofiles/dbmod.o mofiles/commonmod.o \
                      mofiles/apimod.o mofiles/ulex.o
mofiles/apimod.o    : mofiles/dbmod.o
mofiles/runsmod.o   : mofiles/testsmod.o

# Removed from megamod.o dep:   mofiles/ftail.o
mofiles/megamod.o   : \
   mofiles/rmtmod.o \
   mofiles/commonmod.o \

;; (include "megatest-version.scm")

;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:)
     readline apropos json http-client directory-utils typed-records
     http-client srfi-18 extras format
     http-client srfi-18 extras format)
     )

;; Added for csv stuff - will be removed
;;
(use sparse-vectors)

(require-library mutils)

					    (printf "Sending signal/term to ~A\n" pid)
					    (process-signal pid signal/term))))))
		       (process:children #f))
		      (original-exit exit-code)))))

;; for some switches always print the command to stderr
;;
(if (args:any? "-run" "-runall" "-remove-runs" "-set-state-status" "-kill-runs" "-kill-rerun")
(if (args:any-defined? "-run" "-runall" "-remove-runs" "-set-state-status" "-kill-runs" "-kill-rerun")
    (debug:print 0 *default-log-port* (string-intersperse (argv) " ")))

;; some switches imply homehost. Exit here if not on homehost
;;
(let ((homehost-required  (list "-cleanup-db" "-server")))
  (if (apply args:any? homehost-required)
  (if (apply args:any-defined? homehost-required)
      (if (not (common:on-homehost?))
	  (for-each
	   (lambda (switch)
	     (if (args:get-arg switch)
		 (begin
		   (debug:print 0 *default-log-port* "ERROR: you must be on the homehost to run with " switch
				", you can move homehost by removing the .homehost file but this will disrupt any runs in progress.")

  (if (null? default)
      (hash-table-ref/default arg-hash arg #f)
      (hash-table-ref/default arg-hash arg (car default))))

(define (any-defined? . args)
  (not (null? (filter (lambda (x) x)
		      (map get-arg args)))))

;; (define any any-defined?)

(define (get-arg-from ht arg . default)
  (if (null? default)
      (hash-table-ref/default ht arg #f)
      (hash-table-ref/default ht arg (car default))))

(define (usage . args)

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

;;======================================================================

(declare (unit rmtmod))
(declare (uses ulex))
;; (declare (uses commonmod))
;; (declare (uses dbmod))
;; (declare (uses megamod))

(module rmtmod
	*
	
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69 format ports srfi-1 matchable)
;; (import commonmod) ;;; DO NOT ALLOW rmt*scm TO DEPEND ON common*scm!!!!
;; (import dbmod)
;; (import megamod)

(use (prefix ulex ulex:))
(import (prefix ulex ulex:))
;; (include "rmt-inc.scm")

;; (include "common_records.scm")
)

;;======================================================================
;; Copyright 2019, 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/>.

;;======================================================================

(declare (unit ulex))

(include "ulex/ulex.scm")

all : example

ulex.so : ulex.scm telemetry/telemetry.so netutil/ulex-netutil.so portlogger/portlogger.so
	chicken-install

telemetry/telemetry.so : telemetry/telemetry.scm
	cd telemetry && chicken-install

example : ulex.so example.scm
	csc example.scm

test : ulex.so
	csi -b tests/run.scm

portlogger/portlogger.so : portlogger/portlogger.scm
	cd portlogger && chicken-install
	csi -s portlogger/test.scm

netutil/ulex-netutil.so: netutil/ulex-netutil.scm
	cd netutil && chicken-install

clean:
	rm -f example *so */*so *.import.* */*.import.*

ulex: thorny evergreen shrubs, also known as furze or gorse.

Your application needs a database but the moment you build in
dependence on Postgresql or Mysql your application becomes ponderous.
Ulex is a mesh networked sqlite3 database, intended to provide a
nimble alternative. It is designed so that nodes can come and go while
talking to each other and sharing data via sqlite3 in a (mostly) ACID
compliant way. Ulex mitigates issues with Sqlite3 on networked
filesystems (e.g. NFS, Moosefs etc.)  such as "lock storms" (*) and
performance bottlenecks.

(*) Network filesystems must provide posix locking across all files
across all clients. This is handled by the file server by a queue. If
the queue gets overwhelmed by lock requests locks may be dropped. This
leads to concurrent access to shared files and in the case of sqlite3
the dreaded "database locked" message that won't go away (to fix you
have to move the file and copy it back). It can also lead to a
corrupted database.

About the name Ulex: The Ulex plant, also known as Gorse, furze, or
Whin, is considered an invasive pest in places like New Zealand but in
spite of its thorny persistence it is considered quite useful in its
native Europe, providing edible flowers, shelter and food for
wildlife, hedges and fuel for cooking.

* move cookie generation to start in (call ...)
* add timestamp from perspective of caller to data passed around
* add standard print for each event
* move portlogger into module (retrieve from Brandon's work)



* Create queues

* Create text line logging interface

* Add registration calls; write, read, transactional, osslow and osfast

* Extend example to cover all aspects

* 

* 

(use telemetry)

;; @startuml
;; Alice -> Bob: Authentication Request
;; Bob --> Alice: Authentication Response

;; Alice -> Bob: Another authentication Request
;; Alice <-- Bob: Another authentication Response
;;
;; ref over Bob
;;   This can be on
;;   several lines
;; end ref
;;
;; @enduml
(define *actor-table* (make-hash-table))
(define *actor-next-id* 0)
(define (get-actor-name key)
  (let* ((cast (string-split "Alice,Bob,Carol,Dave,Eve,Frank,Grace,Heidi,Ivan,Judy,Mallory,Nancy,Oscar,Peggy,Rupert,Sybil,Ted,Victor,Wendy" ","))
         (cast-count (length cast))
         (name (hash-table-ref/default *actor-table* key #f)))
    (cond
     (name name)
     (else
      (let* ((id *actor-next-id*)
             (name (list-ref cast (modulo id cast-count)))
             (seq (inexact->exact (floor (/ id cast-count))))
             (newname
              (conc
               name
               (if (> seq 0)
                   (conc "-" seq)
                   ""))))
        (set! *actor-next-id* (add1 *actor-next-id*))
        (hash-table-set! *actor-table* key newname)
        newname)))))
    

(define (ulex-telemetry-server)
  (let* ((port 12345)
         (seq 0)
         (handler (lambda (msg)
                    (set! seq (add1 seq))
                    (let* ((elapsed-ms (current-milliseconds))
                           (payload    (alist-ref 'payload msg))
                           (action     (if payload (alist-ref 'action   payload)))
                           (from-key   (if payload (alist-ref 'from-key payload)))
                           (to-key     (if payload (alist-ref 'to-key   payload)))
                           )
                      (if (and action from-key to-key)
                          (print (get-actor-name from-key) " -> " (get-actor-name to-key) ": "action))
                      ;;(pp msg)
                      ))))
    (telemetry-server port handler)))

(ulex-telemetry-server)
  

;;; dbi: Minimal gasket to postgresql, sqlite3 and mysql
;;;
;; Copyright (C) 2007-2016 Matt Welland
;; Redistribution and use in source and binary forms, with or without
;; modification, is permitted.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
;; OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
;; DAMAGE.

(use regex srfi-18 matchable)

(load "ulex.scm")
(import (prefix ulex ulex:))

(create-directory "ulexdb" #t)
(create-directory "pkts"   #f)

(define *area* (ulex:make-area
		dbdir:   (conc (current-directory) "/ulexdb")
		pktsdir: (conc (current-directory) "/pkts") 
		))
(define (toplevel-command . args) #f)
(use readline)

;; two reserved keys in the ulex registration hash table are:
;;   dbinitsql => a list of sql statements to be executed at db creation time
;;   dbinitfn  => a function of two params; dbh, the sql-de-lite db handle and
;;                dbfname, the database filename
;;
(ulex:register-batch
 *area*
 'dbwrite
 `((dbinitsql . ("CREATE TABLE IF NOT EXISTS messages (id INTEGER PRIMARY KEY, message TEXT, author TEXT, msg_time INTEGER);"))
   (savemsg   . "INSERT INTO messages (message,author) VALUES (?,?)")
   ))
		 
(ulex:register-batch
 *area*
 'dbread
 `((dbinitsql . ("CREATE TABLE IF NOT EXISTS messages (id INTEGER PRIMARY KEY, message TEXT, author TEXT, msg_time INTEGER);"))
   (getnum    . "SELECT COUNT(*) FROM messages")
   (getsome   . "SELECT * FROM messages LIMIT 10")
   ))
		 
(define (worker mode-in)
  (let* ((start (current-milliseconds))
        (iters-per-sample 10)
	(mode (string->symbol mode-in))
	(max-count (case mode
		     ((all) 60)
		     (else  1000)))
	(num-calls 0)
	(report (lambda ()		  
		  (let ((delta (- (current-milliseconds) start)))
		    (print "Completed " num-calls " in " delta
			   " for " (/ num-calls (/ delta 1000)) " calls per second")))))
    (if (eq? mode 'repl)
	(begin
	  (import extras) ;; might not be needed
	  ;; (import csi)
	  (import readline)
	  (import apropos)
	  (import (prefix ulex ulex:))
	  (install-history-file (get-environment-variable "HOME") ".example_history") ;;  [homedir] [filename] [nlines])
	  (current-input-port (make-readline-port "example> "))
	  (repl))
	(let loop ((count 0))
	  ;; (print "loop count=" count)
	  (for-each
	   (lambda (dbname)
	     ;;(print "TOP OF LAMBDA")
	     (case mode
	       ((all)
		(let ((start-time (current-milliseconds))
		      (message    (conc "Test message #" count "! From pid: " (current-process-id)))
		      (user (current-user-name)))
		  (ulex:call *area* dbname 'savemsg `(,message ,user))
		  (for-each (lambda (n)
			      (print "have this many " (ulex:call *area* dbname 'getnum  '()) " records in main.db"))
			    (iota 10))
		  (set! num-calls (+ num-calls 11))
		  ))
	       
	       ((ping)
		(let ((srvrs (ulex:get-all-server-pkts *area*)))
		  (for-each
		   (lambda (srv)
		     (print "Pinging " srv)
		     (ulex:ping *area* srv))
		   srvrs)))
	       ((fullping)
		(let ((srvrs (ulex:get-all-server-pkts *area*)))
		  (for-each
		   (lambda (srv)
		     (let ((ipaddr (alist-ref 'ipaddr srv))
			   (port   (any->number (alist-ref 'port srv))))
		       (print "Full Ping to " srv)
		       (ulex:ping *area* ipaddr port)))
		   srvrs)))
	       ((passive)
		(thread-sleep! 10))
	       ))
	   '("main.db")) ;; "test.db" "run-1.db" "run-2.db" "run-3.db" "run-4.db"))
	  #;(thread-sleep! 0.001)
	  #;(let ((now (current-milliseconds)))
	    (if (and (> now start)
		     (eq? (modulo count iters-per-sample) 0))
		(begin
		  (print "queries per second: "(* 1000.0 (/ iters-per-sample (- now start))))
		  (set! count 0)
		  (set! start (current-milliseconds)))))
	  ;; (print "count: " count " max-count: " max-count)
	  (if (< count max-count)
	      (loop (+ count 1)))))
    (report)
    (ulex:clear-server-pkt *area*)
    (thread-sleep! 5) ;; let others keep using this server (needs to be built in to ulex)
        ;; (print "Doing stuff")
    ;; (thread-sleep! 10)
    (print "Done doing stuff")))

(define (run-worker)
  (thread-start!
   (make-thread (lambda ()
		  (thread-sleep! 5)
		  (worker "all"))
		"worker")))

(define (main . args)
    (if (member (car args) '("repl"))
	(print "NOTE: No exit timer started.")
	(thread-start! (make-thread (lambda ()
				      (thread-sleep! (* 60 5))
				      (ulex:clear-server-pkt *area*)
				      (thread-sleep! 5)
				      (exit 0)))))
    (print "Launching server")
    (ulex:launch *area*)
    (print "LAUNCHED.")
    (thread-sleep! 0.1) ;; chicken threads bit quirky? need little time for launch thread to get traction?
    (apply worker args)
    )

;;======================================================================
;; Strive for clean exit handling
;;======================================================================

;; Ulex shutdown is handled within Ulex itself.

#;(define (server-exit-procedure)
  (on-exit (lambda ()
	     ;; close the databases, ensure the pkt is removed!
	     ;; (thread-sleep! 2)
	     (ulex:shutdown *area*)
	     0)))

;; Copied from the SDL2 examples.
;;
;; Schedule quit! to be automatically called when your program exits normally.
#;(on-exit server-exit-procedure)

;; Install a custom exception handler that will call quit! and then
;; call the original exception handler. This ensures that quit! will
;; be called even if an unhandled exception reaches the top level.
#;(current-exception-handler
 (let ((original-handler (current-exception-handler)))
   (lambda (exception)
     (server-exit-procedure)
     (original-handler exception))))

(if (file-exists? ".examplerc")
    (load ".examplerc"))

(let ((args-in (argv))) ;; command-line-arguments)))
  (let ((args (match
	       args-in
	       (("csi" "--" args ...) args)
	       ((_ args ...) args)
	       (else args-in))))
    (if (null? args)
	(begin
	  (print "Usage: example [mode]")
	  (print "  where mode is one of:")
	  (print "   ping     : only do pings between servers")
	  (print "   fullping : ping with response via processing queue")
	  (print "   unix     : only do unix commands")
	  (print "   read     : only do ping, unix and db reads")
	  (print "   all      : do pint, unix, and db reads and writes")
	  (exit))
	(apply main args))))

(use ulex-netutil)
(use test)

(test #f #t (not (not (member "127.0.0.1" (get-all-ips)))))

;; -*- scheme -*-
(
; Your egg's license:
(license "BSD")

; Pick one from the list of categories (see below) for your egg and enter it
; here.
(category db)

(needs foreign )

; A list of eggs required for TESTING ONLY.  See the `Tests' section.
(test-depends test)

(author "Brandon Barclay")
(synopsis "Get all IP addresses for all interfaces."))

(repo fossil "http://www.kiatoa.com/cgi-bin/fossils/{egg-name}")
(uri zip "http://www.kiatoa.com/cgi-bin/fossils/{egg-name}/zip/{egg-name}.zip?uuid={egg-release}")
(release "0.1")

;;; ulex: Distributed sqlite3 db
;;;
;; Copyright (C) 2018 Matt Welland
;; Redistribution and use in source and binary forms, with or without
;; modification, is permitted.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
;; OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
;; DAMAGE.

;;======================================================================
;; ABOUT:
;;   See README in the distribution at https://www.kiatoa.com/fossils/ulex
;; NOTES:
;;   provides all ipv4 addresses for all interfaces
;;
;;======================================================================

;; get IP addresses from ALL interfaces
(module ulex-netutil
    (get-all-ips get-my-best-address get-all-ips-sorted)

(import scheme chicken data-structures foreign ports regex-case posix)


;; #include <stdio.h>
;; #include <netinet/in.h>
;; #include <string.h>
;; #include <arpa/inet.h>

(foreign-declare "#include \"sys/types.h\"")
(foreign-declare "#include \"sys/socket.h\"")
(foreign-declare "#include \"ifaddrs.h\"")
(foreign-declare "#include \"arpa/inet.h\"")

;; get IP addresses from ALL interfaces
(define get-all-ips
  (foreign-safe-lambda* scheme-object ()
    "

// from https://stackoverflow.com/questions/17909401/linux-c-get-default-interfaces-ip-address :


    C_word lst = C_SCHEME_END_OF_LIST, len, str, *a;
//    struct ifaddrs *ifa, *i;
//    struct sockaddr *sa;

    struct ifaddrs * ifAddrStruct = NULL;
    struct ifaddrs * ifa = NULL;
    void * tmpAddrPtr = NULL;

    if ( getifaddrs(&ifAddrStruct) != 0)
      C_return(C_SCHEME_FALSE);

//    for (i = ifa; i != NULL; i = i->ifa_next) {
    for (ifa = ifAddrStruct; ifa != NULL; ifa = ifa->ifa_next) {
        if (ifa->ifa_addr->sa_family==AF_INET) { // Check it is
            // a valid IPv4 address
            tmpAddrPtr = &((struct sockaddr_in *)ifa->ifa_addr)->sin_addr;
            char addressBuffer[INET_ADDRSTRLEN];
            inet_ntop(AF_INET, tmpAddrPtr, addressBuffer, INET_ADDRSTRLEN);
//            printf(\"%s IP Address %s\\n\", ifa->ifa_name, addressBuffer);
            len = strlen(addressBuffer);
            a = C_alloc(C_SIZEOF_PAIR + C_SIZEOF_STRING(len));
            str = C_string(&a, len, addressBuffer);
            lst = C_a_pair(&a, str, lst);
        } 

//        else if (ifa->ifa_addr->sa_family==AF_INET6) { // Check it is
//            // a valid IPv6 address
//            tmpAddrPtr = &((struct sockaddr_in6 *)ifa->ifa_addr)->sin6_addr;
//            char addressBuffer[INET6_ADDRSTRLEN];
//            inet_ntop(AF_INET6, tmpAddrPtr, addressBuffer, INET6_ADDRSTRLEN);
////            printf(\"%s IP Address %s\\n\", ifa->ifa_name, addressBuffer);
//            len = strlen(addressBuffer);
//            a = C_alloc(C_SIZEOF_PAIR + C_SIZEOF_STRING(len));
//            str = C_string(&a, len, addressBuffer);
//            lst = C_a_pair(&a, str, lst);
//       }

//       else {
//         printf(\" not an IPv4 address\\n\");
//       }

    }

    freeifaddrs(ifa);
    C_return(lst);

"))

;; Change this to bias for addresses with a reasonable broadcast value?
;;
(define (ip-pref-less? a b)
  (let* ((rate (lambda (ipstr)
                 (regex-case ipstr
                             ( "^127\\." _ 0 )
                             ( "^(10\\.0|192\\.168\\.)\\..*" _ 1 )
                             ( else 2 ) ))))
    (< (rate a) (rate b))))
  

(define (get-my-best-address)
  (let ((all-my-addresses (get-all-ips))
        ;;(all-my-addresses-old (vector->list (hostinfo-addresses (hostname->hostinfo (get-host-name)))))
        )
    (cond
     ((null? all-my-addresses)
      (get-host-name))                                          ;; no interfaces?
     ((eq? (length all-my-addresses) 1)
      (car all-my-addresses))                      ;; only one to choose from, just go with it
     
     (else
      (car (sort all-my-addresses ip-pref-less?)))
     ;; (else 
     ;;  (ip->string (car (filter (lambda (x)                      ;; take any but 127.
     ;;    			 (not (eq? (u8vector-ref x 0) 127)))
     ;;    		       all-my-addresses))))

     )))

(define (get-all-ips-sorted)
  (sort (get-all-ips) ip-pref-less?))

)

;; Copyright 2007-2018, Matthew Welland.
;;
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;;
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

;;;; ulex.setup
(standard-extension 'ulex-netutil "0.1")

;; -*- scheme -*-
(
; Your egg's license:
(license "BSD")

; Pick one from the list of categories (see below) for your egg and enter it
; here.
(category db)

(needs foreign )

; A list of eggs required for TESTING ONLY.  See the `Tests' section.
(test-depends test sqlite3 regex)

(author "Matthew Welland")
(synopsis "thoughtfully optain tcp port."))

(repo fossil "http://www.kiatoa.com/cgi-bin/fossils/{egg-name}")
(uri zip "http://www.kiatoa.com/cgi-bin/fossils/{egg-name}/zip/{egg-name}.zip?uuid={egg-release}")
(release "0.1")

;;======================================================================
;; P O R T L O G G E R  -  track ports used on the current machine
;;======================================================================

;; 

(module portlogger
    (pl-open-run-close pl-find-port pl-release-port pl-open-db pl-get-prev-used-port pl-get-port-state pl-take-port)
  (import scheme
          posix
          chicken
          data-structures
                                        ;ports
          extras
                                        ;files
                                        ;mailbox
                                        ;telemetry
          regex
                                        ;regex-case
          
          )
  (use (prefix sqlite3 sqlite3:))
  (use posix)
  (use regex)
  
  (define (pl-open-db fname)
    (let* ((avail    #t) ;; for now - assume wait on journal not needed (tasks:wait-on-journal fname 5 remove: #t)) ;; wait up to about 10 seconds for the journal to go away
	   (exists   (file-exists? fname))
	   (db       (if avail 
		         (sqlite3:open-database fname)
		         (begin
			   (system (conc "rm -f " fname))
			   (sqlite3:open-database fname))))
	   (handler  (sqlite3:make-busy-timeout 136000))
	   (canwrite (file-write-access? fname)))
      (sqlite3:set-busy-handler! db handler)
      (sqlite3:execute db "PRAGMA synchronous = 0;")
      (sqlite3:execute
       db
       "CREATE TABLE IF NOT EXISTS ports (
            port INTEGER PRIMARY KEY,
            state TEXT DEFAULT 'not-used',
            fail_count INTEGER DEFAULT 0,
            update_time TIMESTAMP DEFAULT (strftime('%s','now')) );")
      db))

  (define (pl-open-run-close proc . params)
    (let* ((fname	 (conc "/tmp/." (current-user-name) "-portlogger.db"))
	   (avail	 #t)) ;; (tasks:wait-on-journal fname 10))) ;; wait up to about 10 seconds for the journal to go away
      ;; (handle-exceptions
      ;;	exn
      ;;	(begin
      ;;	  ;; (release-dot-lock fname)
      ;;	  (debug:print-error 0 *default-log-port* "pl-open-run-close failed. " proc " " params)
      ;;	  (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
      ;;	  (debug:print 5 *default-log-port* "exn=" (condition->list exn))
      ;;	  (if (file-exists? fname)(delete-file fname)) ;; brutally get rid of it
      ;;	  (print-call-chain (current-error-port)))
      (let* (;; (lock   (obtain-dot-lock fname 2 9 10))
	     (db	    (pl-open-db fname))
	     (res    (apply proc db params)))
        (sqlite3:finalize! db)
        ;; (release-dot-lock fname)
        res)))
  ;; )

  ;; (fold-row PROC INIT DATABASE SQL . PARAMETERS) 
  (define (pl-take-port db portnum)
    (let* ((qry1 "INSERT INTO ports (port,state) VALUES (?,?);")
	   (qry2 "UPDATE ports SET state=?,update_time=strftime('%s','now') WHERE port=?;"))
      (let* ((curr (pl-get-port-state db portnum))
	     (res	 (case (string->symbol (or curr "n/a"))
		           ((released)	    (sqlite3:execute db qry2 "taken" portnum) 'taken)
		           ((not-tried n/a) (sqlite3:execute db qry1 portnum "taken") 'taken)
		           ((taken)							       'already-taken)
		           ((failed)							       'failed)
		           (else							       'error))))
        ;; (print "res=" res)
        res)))

  (define (pl-get-prev-used-port db)
    ;; (handle-exceptions
    ;;     exn
    ;;     (with-output-to-port (current-error-port)
    ;;	(lambda ()
    ;;	  (print "EXCEPTION: portlogger database probably overloaded or unreadable. If you see this message again remove /tmp/.$USER-portlogger.db")
    ;;	  (print " message: " ((condition-property-accessor 'exn 'message) exn))
    ;;	  (print "exn=" (condition->list exn))
    ;;	  (print-call-chain) ;;	 (current-error-port))
    ;;	  (print "Continuing anyway.")
    ;;	  #f))
    (let ((res (sqlite3:fold-row
	        (lambda (var curr)
		  (or curr var curr))
	        #f
	        db "SELECT port FROM ports WHERE state='released';")))
      (if res res #f)))
  ;; )

  (define (pl-find-port db acfg #!key (lowport 32768))
    ;;(slite3:with-transaction
    ;; db
    ;; (lambda ()
    (let loop ((numtries 0))
      (let* ((portnum (or (pl-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
	;;     (with-output-to-port (current-error-port)
	;;	 (lambda ()
	;;	   (print "EXCEPTION: portlogger database probably overloaded or unreadable. If you see this message again remove /tmp/.$USER-portlogger.db")
	;;	   (print " message: " ((condition-property-accessor 'exn 'message) exn))
	;;	   (print "exn=" (condition->list exn))
	;;	   (print-call-chain)
	;;	   (print "Continuing anyway.")))
	(pl-take-port db portnum) ;; always "take the port"
	(if (pl-is-port-available portnum)
	    portnum
	    (begin
	      (pl-set-port db portnum "taken")
	      (loop (add1 numtries)))))))


  ;; set port to "released", "failed" etc.
  ;; 
  (define (pl-set-port db portnum value)
    (sqlite3:execute db "UPDATE ports SET state=?,update_time=strftime('%s','now') WHERE port=?;") value portnum)

  ;; set port to "released", "failed" etc.
  ;; 
  (define (pl-get-port-state db portnum)
    (let ((res (sqlite3:fold-row	  ;; get the state of given port or "not-tried"
	        (lambda (var curr)  ;; function on init/last current
		  (or curr var curr))
	        #f	  ;; init
	        db "SELECT state FROM ports WHERE port=?;"
	        portnum)))	    ;; the parameter to the query
      (if res res #f)))

  ;; (slite3:exec (slite3:sql db "UPDATE ports SET state=?,update_time=strftime('%s','now') WHERE port=?;") value portnum))

  ;; release port
  (define (pl-release-port db portnum)
    (sqlite3:execute db "UPDATE ports SET state=?,update_time=strftime('%s','now') WHERE port=?;" "released" portnum)
    (sqlite3:change-count db))

  ;; set port to failed (attempted to take but got error)
  ;;
  (define (pl-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)
    (sqlite3:change-count db))

  ;; pulled from mtut - TODO: remove from mtut, find a way *without* using netstat
  ;;
  (define (pl-is-port-available 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 "\\s+")) inl)
		  #f
		  (loop (read-line inp))))
	    #t))))

  ) ;; end module

;; Copyright 2007-2018, Matthew Welland.
;;
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;;
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

;;;; portlogger.setup
(standard-extension 'portlogger "0.1")

(use portlogger)
(use test)

(test-begin "portlogger")
(use (prefix sqlite3 sqlite3:))

(define *port* #f)
(define *area* #f)
(test #f #f (begin
              (pl-open-run-close
               (lambda (db b)
                 (pl-get-prev-used-port db))
               *area*)
              #f))
(test #f #f (pl-open-run-close (lambda (db b)(pl-get-port-state db 1234567)) *area*))
(test #f #f (number? (pl-open-run-close (lambda (db b)(pl-take-port db 123456)) *area*)))
(test #f #t (number? (let ((port (pl-open-run-close pl-find-port *area*)))
		       (set! *port* port)
		       port)))
(test #f 1 (pl-open-run-close pl-release-port *port*))
(test #f "released" (pl-open-run-close
		     (lambda (db)
		       (sqlite3:first-result db "select state from ports where port=?" *port*))))

(test-end "portlogger")

#!/bin/bash

CMD=$1

make example 

for x in $(seq 1 10);do
  ./example $CMD 2>&1| tee run$x.log &
done

wait

#!/bin/bash
csc test-rpc.scm
(./test-rpc 45000 45001 45002 45003 45004 45005|& tee test-rpc-45000.log) &
(./test-rpc 45001 45000 45002 45003 45004 45005|& tee test-rpc-45001.log) &
(./test-rpc 45002 45000 45001 45003 45004 45005|& tee test-rpc-45002.log) &
(./test-rpc 45003 45000 45001 45002 45004 45005|& tee test-rpc-45003.log) &
(./test-rpc 45004 45000 45001 45002 45003 45005|& tee test-rpc-45004.log) &
(./test-rpc 45005 45000 45001 45002 45003 45004|& tee test-rpc-45005.log) &

wait

(load "telemetry.scm")

(import telemetry)

(print 1)
(telemetry-open "localhost" 12346)
(print 2)
(telemetry-send "goo") 
(print 3)
(telemetry-send "goo2") 
(print 4)

(load "telemetry.scm")
(import telemetry)
(print "before")
(use mailbox)
(use mailbox-threads)
(use srfi-18)

(set! handler-seq 0)
(define (handler msg)
  (set! handler-seq (add1 handler-seq))
  (print "=============")
  (print handler-seq msg))
  
(telemetry-server 12346 handler)

  
(print "after")

;; -*- scheme -*-
(
; Your egg's license:
(license "BSD")

; Pick one from the list of categories (see below) for your egg and enter it
; here.
(category db)

; A list of eggs dbi depends on.  If none, you can omit this declaration
; altogether. If you are making an egg for chicken 3 and you need to use
; procedures from the `files' unit, be sure to include the `files' egg in the
; `needs' section (chicken versions < 3.4.0 don't provide the `files' unit).
; `depends' is an alias to `needs'.
(needs udp mailbox-threads z3 base64 )

; A list of eggs required for TESTING ONLY.  See the `Tests' section.
(test-depends test)

(author "Brandon Barclay")
(synopsis "A telemetry send/receive system using udp."))

(repo fossil "http://www.kiatoa.com/cgi-bin/fossils/{egg-name}")
(uri zip "http://www.kiatoa.com/cgi-bin/fossils/{egg-name}/zip/{egg-name}.zip?uuid={egg-release}")
(release "0.1")

(module telemetry
    (telemetry-open telemetry-send telemetry-close telemetry-server
                    telemetry-show-debugs telemetry-hide-debugs )
  
  (import chicken scheme data-structures
          base64 srfi-18
          z3 udp posix extras ports mailbox mailbox-threads)

  (use udp)
  (use base64)
  (use z3)
  (use mailbox-threads)
  
  (define *telemetry:telemetry-log-state* 'startup)
  (define *telemetry:telemetry-log-socket* #f)

  (define *debug-print-flag* #f)

  (define (telemetry-show-debugs)
    (set! *debug-print-flag* #t))

  (define (telemetry-hide-debugs)
    (set! *debug-print-flag* #f))

  (define (debug-print  . args)
    (if *debug-print-flag*
        (apply print "telemetry> " args)))

  (define (make-telemetry-server-thread port callback)
    (let* ((thr
            (make-thread
             (lambda ()
               (let* ((s (udp-open-socket)))
                 (udp-bind! s #f port)
                 ;;(udp-connect! s "localhost" port)
                 (let loop ((seq 0))
                   (debug-print "loop seq="seq)
                   (receive (n data from-host from-port) (udp-recvfrom s 640000)
                     (let* ((encapsulated-payload
                             (with-input-from-string
                                 (z3:decode-buffer
                                  (base64-decode data)) read))
                            (callback-res `( (from-host . ,from-host)
                                             (from-port . ,from-port)
                                             (data-len  . ,n)
                                             ,@encapsulated-payload )))
                       (callback callback-res))
                     
                       )
                   (loop (add1 seq)))
                 (udp-close-socket s))))))
      (thread-start! thr)
      thr))

  (define (telemetry-server port handler-callback)
    (let* ((serv-thread (make-telemetry-server-thread port handler-callback)))
      (print serv-thread)
      (thread-join! serv-thread)))

  
  (define (telemetry-open serverhost serverport)
    (let* ((user (or (get-environment-variable "USER") "unknown"))
           (host (or (get-environment-variable "HOST") "unknown")))
      (set! *telemetry:telemetry-log-state*
            (handle-exceptions
             exn
             (begin
               (debug-print "telemetry-open udp port failure")
               'broken)
             (if (and serverhost serverport user host)
                 (let* ((s (udp-open-socket)))
                   ;;(udp-bind! s #f 0)
                   (udp-connect! s serverhost serverport)
                   (set! *telemetry:telemetry-log-socket* s)
                   'open)
                 'not-needed)))))


  (define (telemetry-close)
    (when (or (member *telemetry:telemetry-log-state* '(broken-or-no-server-preclose open)) *telemetry:telemetry-log-socket*)
      (handle-exceptions
       exn
       (begin
         (define *telemetry:telemetry-log-state* 'closed-fail)
         (debug-print "telemetry-telemetry-log closure failure")
         )
       (begin
         (define *telemetry:telemetry-log-state* 'closed)
         (udp-close-socket *telemetry:telemetry-log-socket*)
         (set! *telemetry:telemetry-log-socket* #f)))))

    (define (telemetry-send payload)
    (if (eq? 'open *telemetry:telemetry-log-state*)
        (handle-exceptions
         exn
         (begin
           (debug-print "telemetry-telemetry-log comms failure ; disabled (no server?)")
           (define *telemetry:telemetry-log-state* 'broken-or-no-server-preclose)
           (telemetry-close)
           (define *telemetry:telemetry-log-state* 'broken-or-no-server)
           (set! *telemetry:telemetry-log-socket* #f)
           )
         (if (and *telemetry:telemetry-log-socket* payload) 
             (let* ((user (or (get-environment-variable "USER") "unknown"))
                    (host (or (get-environment-variable "HOST") "unknown"))
                    (encapsulated-payload
                     `( (user . ,user)
                        (host . ,host)
                        (pid . ,(current-process-id))
                        (payload . ,payload) ) )
                    (msg
                     (base64-encode
                      (z3:encode-buffer
                       (with-output-to-string (lambda () (pp encapsulated-payload)))))))
               ;;(debug-print "pre-send")
               (let ((res (udp-send *telemetry:telemetry-log-socket* msg)))
                 ;;(debug-print "post-send >"res"<")
                 res)
               
               )))) )


  )

;; Copyright 2007-2018, Matthew Welland.
;;
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;;
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

;;;; ulex.setup
(standard-extension 'telemetry "0.1")

(use rpc posix srfi-1 pkts)

(define *usage* "Usage: test-rpc") ;;  myportnum [port-nums...]")

#;(define *portnums* (let ((args (command-line-arguments)))
		     (if (null? args)
			 (begin
			   (print *usage*)
			   (exit))
			 (map string->number args))))

#;(if (not (null? (filter (lambda (x)(not x)) *portnums*)))
    (begin
      (print "ERROR: portnumbers must all be integers, you gave " *portnums*)
      (exit)))


(define (find-free-port-and-open port)
  (handle-exceptions
   exn
   (begin
     (print "Failed to bind to port " (rpc:default-server-port) ", trying next port")
     (find-free-port-and-open (+ port 1)))
   (rpc:default-server-port port)
   (tcp-read-timeout 120000)
   (tcp-listen (rpc:default-server-port) )
   port))

#;(define *myportnum* (car *portnums*))
#;(define *clients*   (cdr *portnums*))

#;(print "Setting up server on " *myportnum*)
;; (rpc:default-server-port *myportnum*)
(define *myportnum* (find-free-port-and-open 20000)) ;; *myportnum*))



;;;; server.scm
(rpc:publish-procedure!
 'foo
 (lambda (x)
   (print "foo: " x)
   (conc "response from " *myportnum*)))

(define *queue* (make-queue))

(rpc:publish-procedure!
 'queue-add
 (lambda (dbfname qrystr raddr rport . params)
   (queue-add! *queue* (list dbfname qrystr raddr rport params))))

;;;; client.scm
(define (call n)
  (let ((port (list-ref *clients* (random (length *clients*)))))
    (print "calling to " port)
    ((rpc:procedure 'foo "localhost" port) n)))

(rpc:publish-procedure!
 'fini
 (lambda () (print "fini") (thread-start! (lambda () (thread-sleep! 3) (print "terminate") (exit))) #f))

(let* ((server-th (make-thread (lambda ()
				 ((rpc:make-server (tcp-listen *myportnum*)) #t)) ;; (rpc:default-server-port))) #t))
			       "server thread"))
       (timer-th  (make-thread (lambda ()
				 (thread-sleep! 30)
				 (print "Node " *myportnum* ", 30 seconds up. Exiting.")
				 (exit)))))
  (thread-start! server-th)
  (thread-start! timer-th)
  (thread-sleep! 1)
  (do ((i 10000 (sub1 i)))
      ((zero? i))
    (print "-> " (call (random 100)))))

(import trace (prefix ulex ulex:))
(trace-call-sites #t)

;; (trace ulex:receive-message ulex:std-peer-handler ulex:process-db-queries ulex:work-queue-add ulex:call send-message ulex:get-best-server ulex:ping)
(set! *default-error-port* (current-output-port))

(ulex:call *area* "test.db" 'savemsg '("my message" "matt"))

(define *servers* (ulex:get-all-server-pkts *area*))

(define numofrecords (ulex:call *area* "test.db" 'getnum  '()))
;; (define bunchofrecords (ulex:call *area* "test.db" 'getsome '()))

(use test (prefix sqlite3 sqlite3:) posix)
(if (file-exists? "ulex.scm")
    (load "ulex.scm")
    (load "../ulex.scm"))

(use trace)
(trace-call-sites #t)

(import ulex ) ;; (import (prefix ulex ulex:))


(test-begin "faux-mtdb")
;; pre-clean

(for-each (lambda (dir)
            (if (directory-exists? dir)
                (system (conc "/bin/rm -rf ./"dir)))
            (system (conc "/bin/mkdir -p ./"dir))
            )
          '("faux-mtdb" "faux-mtdb-pkts"))


(let* ((area     (make-area dbdir: "faux-mtdb" pktsdir: "faux-mtdb-pkts"))
       (specfile "tests/mt-spec.sexpr")
       (dbname "faux-mt.db"))
  (launch area)
  (initialize-area-calls-from-specfile area specfile)

  
  (let* ((target-name "a/b/c/d")
         (insert-result (call area dbname 'new-target (list target-name)))
         (test-target-id (caar (call area dbname 'target-name->target-id (list target-name))))
         (test-target-name (caar (call area dbname 'target-id->target-name (list 1)))))
    (test #f #t insert-result)
    (test #f 1 test-target-id )
    (test #f target-name test-target-name )
    )
  
  (test #f #t (shutdown area)))

;; thought experiment - read cursors
;; (let* ((cursor (call area dbname 'get-target-names '())))
;;   (let loop ((row (cursor)))
;;     (cond
;;      ((not row) #t)
;;      (else
;;       (print "ROW IS "row)
;;       (loop (cursor))))))


(test-end "faux-mtdb")


       

(
 (dbwrite .
          (
           (dbinitsql . (
                         "create table if not exists targets(id integer primary key,name)"
                         "create table if not exists runs(id integer primary key,target_id,name,path,state,status)"
                         "create table if not exists tests(id integer primary key,run_id,name,path,state,status,host)"
                         "create table if not exists test_steps(id integer primary key,test_id,name,state)" ))
           
           ( new-target . "insert into targets (name) values(?);")
           ( new-run    . "insert into runs (target_id,name,path,state,status) values(?,?,\"/dev/null\",\"NOT STARTED\",\"n/a\")")
           ( new-test    . "insert into tests values(?,?,?,\"/dev/null\",\"NOT STARTED\")")
           ( update-one-run_id-state-status . "update runs set state=? status=? where id=?" ) 
           ( update-one-test_id-state-status . "update tests set state=? status=? where id=?" )
           ( update-matching-tests-state-status . "update tests set state=? status=? where run_id=?, state like ?, status like ?")
           )
          )
 (dbread .
         (
          (get-targets . "select id,name from targets")
          (target-name->target-id . "select id from targets where name=?")
          (target-id->target-name . "select name from targets where id=?")
          (check-test-state-status . "select state,status from tests where id=?")
          )
         )

 )
          

(use test (prefix sqlite3 sqlite3:) posix ulex-netutil rpc pkts mailbox)

;; (use (prefix ulex ulex:))
(if (file-exists? "ulex.scm")
    (load "ulex.scm")
    (load "../ulex.scm"))

(use trace)
(trace-call-sites #t)

(import ulex) ;; (import (prefix ulex ulex:))

(trace
 ;; send-message
 ;; receive-message
 ;; std-peer-handler
 ;; work-queue-add
 ;; deliver-response
 ;; finalize-all-db-handles
 ;; area-dbhandles
 ;; save-dbh
 ;; process-db-queries

 ;; dbdat-dbh
 ;; get-best-server
 ;; calc-server-score
 ;; ping
 ;; full-ping
 ;; register-node
 ;; calc-server-score
 ;; update-known-servers
 ;; request
 ;; get-dbh
 ;; update-stats
 ;; process-db-queries
 ;; deliver-response
 )

(test-begin "misc")
(test #f #t (string? (get-my-best-address)))
(test-end   "misc")

;;======================================================================
;; Setup
;;======================================================================

(system "rm -rf testulexdb testpkts")
(create-directory "testulexdb" #t)
(create-directory "testpkts"   #t)

(define *area* (make-area dbdir: "testulexdb" pktsdir: "testpkts"))

(define *port* #f)

;;======================================================================
;; Ulex-db
;;======================================================================

(test-begin "ulex-db")
(test #f #t (equal? (area-dbdir *area*) "testulexdb"))
(test #f #t (thread? (thread-start! (make-thread (lambda ()(launch *area*)) "server"))))
(thread-sleep! 1)
(test #f 1  (update-known-servers *area*))
(test #f #t (list? (get-all-server-pkts *area*)))
(test #f (area-myaddr *area*) (cadr (ping *area* (area-myaddr *area*)(area-port *area*))))

(let loop ((count 10))
  (if (null? (get-all-server-pkts *area*))
      (if (> count 0)
	  (begin
	    (thread-sleep! 1)
	    (print "waiting for server pkts")
	    (loop (- count 1))))))
(test #f #t (let ((spkts (get-all-server-pkts *area*)))
	      (and (list spkts) (> (length spkts) 0))))
(test #f #t (begin (register-batch
		    *area*
		    'dbwrite ;; this is the call type
		    `((dbinitsql . ("CREATE TABLE IF NOT EXISTS messages (id INTEGER PRIMARY KEY, message TEXT, author TEXT, msg_time INTEGER);"))
		      (savemsg   . "INSERT INTO messages (message,author) VALUES (?,?)")
		      ;; (readmsg   . "SELECT * FROM messages WHERE author=?;")
		      
		      ))
		   #t))

(test #f #t (calldat? (get-rentry *area* 'dbinitsql)))
(define cdat1 (get-rentry *area* 'dbinitsql))
(test #f #t (list? (get-best-server *area* "test.db" 'savemsg)))
(test #f #t (eq? 'dbwrite (calldat-ctype cdat1)))
(test #f #t (list? (get-rsql *area* 'dbinitsql)))
(test #f #t  (dbdat? (open-db *area* "test.db")))

(test #f #t (dbdat? (let ((dbh (get-dbh *area* "test.db")))
		      (save-dbh *area* "test.db" dbh)
		      dbh)))
(test #f #t (dbdat? (let ((dbh (get-dbh *area* "test.db")))
		      dbh)))

;(test #f '(#t "db write submitted" #t)  (call *area* "test.db" 'savemsg '("Test message!" "matt")))
(test #f #t  (call *area* "test.db" 'savemsg '("Test message!" "matt")))
;;(thread-sleep! 15);; server needs time to process the request (it is non-blocking)
;; (test #f #t (shutdown *area*))
;; (test #f 0 (calc-server-score *area* "test.db"  (area-pktid *area*)))

(test #f #t (list? (get-best-server *area* "test.db" (area-pktid *area*))))
(define *best-server* (car (get-best-server *area* "test.db" (area-pktid *area*))))
(pp *best-server*)
(define *server-pkt*  (hash-table-ref/default (area-hosts *area*) (area-pktid *area*) #f))
(define *server-ip*   (alist-ref 'ipaddr *server-pkt*))
(define *server-port* (any->number (alist-ref 'port *server-pkt*)))
(test #f #t (list? (ping      *area* *server-ip* *server-port*)))

(test #f #t (process-db-queries *area* "test.db"))
(test #f #f (process-db-queries *area* "junk.db"))
;; (test #f #t (cadr (full-ping *area* *server-pkt*)))


(test-end "ulex-db")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(test-begin "faux-mtdb")
;; pre-clean

#;(for-each (lambda (dir)
            (if (directory-exists? dir)
                (system (conc "/bin/rm -rf ./"dir)))
            (system (conc "/bin/mkdir -p ./"dir))
            )
          '("faux-mtdb" "faux-mtdb-pkts"))


(let* ((area     *area*) ;; (make-area dbdir: "faux-mtdb" pktsdir: "faux-mtdb-pkts"))
       (specfile "tests/mt-spec.sexpr")
       (dbname   "faux-mt.db"))
  ;; (launch area)
  (initialize-area-calls-from-specfile area specfile)
  (let* ((target-name "a/b/c/d")
         (insert-result (call area dbname 'new-target (list target-name)))
         (test-target-id (caar (call area dbname 'target-name->target-id (list target-name))))
         (test-target-name (caar (call area dbname 'target-id->target-name (list 1)))))
    (test #f #t insert-result)
    (test #f 1 test-target-id )
    (test #f target-name test-target-name )
    )
  (test #f #t (list? (get-best-server *area* "test.db" 'savemsg)))
  (thread-sleep! 5)
  (test #f #t (begin (shutdown area) #t)))
  
(test #f #t (process-db-queries *area* "test.db"))
(test #f #f (process-db-queries *area* "junk.db"))

;; thought experiment - read cursors
;; (let* ((cursor (call area dbname 'get-target-names '())))
;;   (let loop ((row (cursor)))
;;     (cond
;;      ((not row) #t)
  ;;      (else
;;       (print "ROW IS "row)
;;       (loop (cursor))))))

  
(test-end "faux-mtdb")

;;======================================================================
;; Portlogger tests
;;======================================================================

;; (test-begin "portlogger")
;; 
;; (test #f #f (begin (pl-open-run-close (lambda (db b)(pl-get-prev-used-port db)) *area*) #f))
;; (test #f #f (pl-open-run-close (lambda (db b)(pl-get-port-state db 1234567)) *area*))
;; (test #f #f (number? (pl-open-run-close (lambda (db b)(pl-take-port db 123456)) *area*)))
;; (test #f #t (number? (let ((port (pl-open-run-close pl-find-port *area*)))
;; 		       (set! *port* port)
;; 		       port)))
;; (test #f 1 (pl-open-run-close pl-release-port *port*))
;; (test #f "released" (pl-open-run-close
;; 		     (lambda (db)
;; 		       (sqlite3:first-result db "select state from ports where port=?" *port*))))
;; 
;; (test-end "portlogger")

;; -*- scheme -*-
(
; Your egg's license:
(license "BSD")

; Pick one from the list of categories (see below) for your egg and enter it
; here.
(category db)

; A list of eggs dbi depends on.  If none, you can omit this declaration
; altogether. If you are making an egg for chicken 3 and you need to use
; procedures from the `files' unit, be sure to include the `files' egg in the
; `needs' section (chicken versions < 3.4.0 don't provide the `files' unit).
; `depends' is an alias to `needs'.
(needs rpc pkts mailbox sqlite3)

; A list of eggs required for TESTING ONLY.  See the `Tests' section.
(test-depends test)

(author "Matt Welland")
(synopsis "A distributed mesh-like layer for sqlite3."))

(repo fossil "http://www.kiatoa.com/cgi-bin/fossils/{egg-name}")
(uri zip "http://www.kiatoa.com/cgi-bin/fossils/{egg-name}/zip/{egg-name}.zip?uuid={egg-release}")
(release "0.1")