Megatest

Diff
Login

Differences From Artifact [340e19da02]:

To Artifact [d550770e12]:


31
32
33
34
35
36
37





38
39
40
41
42
43
44
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49







+
+
+
+
+







(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.

(declare (uses commonmod))
(import commonmod)

(declare (uses dbmod))
(import dbmod)

(declare (uses rmt))

(declare (uses servermod))
(import servermod)

(include "common_records.scm")
(include "db_records.scm")

;; client:get-signature
(define (client:get-signature)
  (if *my-client-signature* *my-client-signature*
99
100
101
102
103
104
105
106

107
108
109
110
111
112
113
114

115
116

117
118
119
120
121
122
123
104
105
106
107
108
109
110

111
112
113
114
115
116
117


118


119
120
121
122
123
124
125
126







-
+






-
-
+
-
-
+







		  (port  (caddr server-dat))
                  (server-id (caddr (cddr server-dat))))
	      (debug:print-info 4 *default-log-port* "client:setup server-dat=" server-dat ", remaining-tries=" remaining-tries)
	      (if (and (not area-dat)
		       (not *runremote*))
                  (begin
		    ;; POSSIBLE BUG. I removed the full initialization call. mrw
		    (set! *runremote* (make-remote)) ;; (create-remote-record))
		    (set! *runremote* (create-remote-record))
                    (let* ((server-info (remote-server-info *runremote*))) 
                      (if server-info
                        (begin
                          (remote-server-url-set! *runremote* (server:record->url server-info))
                          (remote-server-id-set! *runremote* (server:record->id server-info)))))))
	      (if (and host port server-id)
		  (let* ((start-res (case *transport-type*
				      ((http)(http-transport:client-connect host port server-id))))
		  (let* ((start-res (http-transport:client-connect host port server-id))
			 (ping-res  (case *transport-type* 
				      ((http)(rmt:login-no-auto-client-setup start-res)))))
			 (ping-res  (rmt:login-no-auto-client-setup start-res)))
		    (if (and start-res
			     ping-res)
			(let ((runremote (or area-dat *runremote*))) ;; it might have been generated only a few statements ago
			  (remote-conndat-set! runremote start-res) ;; (hash-table-set! runremote run-id start-res)
			  (debug:print-info 2 *default-log-port* "connected to " (http-transport:server-dat-make-url start-res))
			  start-res)
			(begin    ;; login failed but have a server record, clean out the record and try again