Megatest

Check-in [a758074358]
Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.6584-ck5
Files: files | file ages | folders
SHA1: a758074358998afa7eff9d29c0425ba7ee8bdf6b
User & Date: matt on 2021-04-28 23:27:59
Other Links: branch diff | manifest | tags
Context
2021-04-29
09:17
locking of main.db nearly complete check-in: 336e9917b1 user: matt tags: v1.6584-ck5
2021-04-28
23:27
wip check-in: a758074358 user: matt tags: v1.6584-ck5
2021-04-25
23:08
main.db mostly opens check-in: a6984512c6 user: matt tags: v1.6584-ck5
Changes

Modified http-transportmod.scm from [f4c57969ab] to [a5cc6ea588].

93
94
95
96
97
98
99





100
101
102
103
104
105
106
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111







+
+
+
+
+







;; (use  srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest posix-extras)
;; 
;; (use spiffy uri-common intarweb http-client spiffy-request-vars intarweb spiffy-directory-listing)
;; 
;; Configurations for server
(tcp-buffer-size 2048)
(max-connections 2048) 

(defstruct sdat
  host
  port
  uuid)

(define (http-transport:make-server-url hostport)
  (if (not hostport)
      #f
      (conc "http://" (car hostport) ":" (cadr hostport))))

;;======================================================================
219
220
221
222
223
224
225
226

227
228
229
230
231
232
233
224
225
226
227
228
229
230

231
232
233
234
235
236
237
238







-
+







		
		;; get_next_port goes here
		(http-transport:try-start-server ipaddrstr
						 (portlogger:open-run-close portlogger:find-port)))
	      (begin
		(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))
      (set! *server-info* (make-sdat host: ipaddrstr port: portnum))
      (debug:print 0 *default-log-port* "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)
      (if config-hostname ;; this is a hint to bind directly
	  (start-server port: portnum bind-address: (if (equal? config-hostname "-")
							ipaddrstr
455
456
457
458
459
460
461
462
463
464
465
466
467








468
469
470
471
472
473
474
460
461
462
463
464
465
466






467
468
469
470
471
472
473
474
475
476
477
478
479
480
481







-
-
-
-
-
-
+
+
+
+
+
+
+
+








(define (register-server pkts-dir pkt-spec host port servkey ipaddr dbpath)
  (let* ((pkt-dat `((host    . ,host)
		    (port    . ,port)
		    (servkey . ,servkey)
		    (pid     . ,(current-process-id))
		    (ipaddr  . ,ipaddr)
		    (dbpath  . ,dbpath))))
    (write-alist->pkt
     pkts-dir
     pkt-dat
     pktspec: pkt-spec
     ptype: 'server)))
		    (dbpath  . ,dbpath)))
	 (uuid    (write-alist->pkt
		   pkts-dir
		   pkt-dat
		   pktspec: pkt-spec
		   ptype: 'server)))
    (debug:print 0 *default-log-port* "Server on "host":"port" registered in pkt "uuid)
    uuid))

;; ya, fake it for now
;;
(define (register-server-in-db db-file)
  #t)

(define (get-pkts-dir #!optional (apath #f))
597
598
599
600
601
602
603
604
605
606












607
608
609
610
611
612

613
614
615
616

617
618
619
620
621
622
623
604
605
606
607
608
609
610



611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632

633
634
635
636
637
638
639
640







-
-
-
+
+
+
+
+
+
+
+
+
+
+
+






+



-
+







                          (mutex-unlock! *heartbeat-mutex*)
                          (if (and sdat
				   (not changed)
				   (> (- (current-seconds) start-time) 2))
			      (begin
				(debug:print-info 0 *default-log-port* "Received server alive signature, now attempting to lock in server")
				;; create a server pkt in *toppath*/.meta/srvpkts
				
				(register-server pkts-dir *srvpktspec* (get-host-name)
						 (cadr sdat) server-key (car sdat) db-file)

				;; TODO:
				;;   1. change sdat to stuct
				;;   2. add uuid to struct
				;;   3. update uuid in sdat here
				;;
				(sdat-uuid-set! sdat
						(register-server
						 pkts-dir *srvpktspec*
						 (get-host-name)
						 (sdat-port sdat) server-key
						 (sdat-host sdat) db-file))

				;; now read pkts and see if we are a contender
				(let* ((all-pkts     (get-all-server-pkts pkts-dir *srvpktspec*))
				       (viables      (get-viable-servers all-pkts db-file))
				       (best-srv     (get-best-candidate viables db-file))
				       (best-srv-key (if best-srv (alist-ref 'servkey best-srv) #f)))
				  (debug:print 0 *default-log-port* "best-srv-key: "best-srv-key", server-key: "server-key)
				  ;; am I the best-srv, compare server-keys to know
				  (if (and (equal? best-srv-key server-key)
					   (register-server-in-db db-file))
				      (if (db:get-iam-server-lock *dbstruct-db* run-id)
				      (if (db:get-iam-server-lock *dbstruct-db* *toppath* run-id)
					  (debug:print 0 *default-log-port* "I'm the server!")
					  (bdat-time-to-exit-set! *bdat* #t))) ;; nope, we are not needed, exit when can do
				  sdat))
                              (begin
				(debug:print-info 0 *default-log-port* "Still waiting, last-sdat=" last-sdat)
                                (sleep 4)
				(if (> (- (current-seconds) start-time) 120) ;; been waiting for two minutes
671
672
673
674
675
676
677

678

679
680
681
682
683
684
685
688
689
690
691
692
693
694
695

696
697
698
699
700
701
702
703







+
-
+







	  (loop (+ count 1) 'running bad-sync-count (current-milliseconds)))
      
      ;; Check that iface and port have not changed (can happen if server port collides)
      (mutex-lock! *heartbeat-mutex*)
      (set! sdat *server-info*)
      (mutex-unlock! *heartbeat-mutex*)
      
      (if (or (not (equal? (sdat-host sdat) iface))
      (if (not (equal? sdat (list iface port)))
	      (not (equal? (sdat-port sdat) port)))
	  (let ((new-iface (car sdat))
		(new-port  (cadr sdat)))
	    (debug:print-info 0 *default-log-port* "WARNING: interface changed, refreshing iface and port info")
	    (set! iface new-iface)
	    (set! port  new-port)
             (if (not *server-id*)
              (set! *server-id* (server:mk-signature)))

Modified megatest.scm from [bf020dc21f] to [299bf0c06c].

807
808
809
810
811
812
813
814

815
816
817
818
819
820
821
807
808
809
810
811
812
813

814
815
816
817
818
819
820
821







-
+







;;      	 (list? n))
;;          (member *verbosity* n))))

     ;; this segment will run launch:setup only if -log is not set. This is fairly safe as servers are not
     ;; manually started and thus should never be started in a non-megatest area. Thus no need to handle situation
     ;; where (launch:setup) returns #f?
     ;;
     (if (or (args:get-arg "-log")(args:get-arg "-server")) ;; redirect the log always when a server
     (if (or (args:get-arg "-log")#;(args:get-arg "-server")) ;; redirect the log always when a server
         (handle-exceptions
     	exn
     	(begin
     	  (print "ERROR: Failed to switch to log output. " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
     	  )
           (let* ((tl   (or (args:get-arg "-log")(launch:setup)))   ;; run launch:setup if -server, ensure we do NOT run launch:setup if -log specified
     	     (logf (or (args:get-arg "-log") ;; use -log unless we are a server, then craft a logfile name