1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
|
(hash-table-set! *logged-in-clients* client-key (current-seconds))
(server:reply return-address qry-sig #t '(#t "successful login"))) ;; path matches - pass! Should vet the caller at this time ...
(server:reply return-address qry-sig #f (list #f (conc "Login failed due to mismatch paths: " calling-path ", " *toppath*)))))))
((flush sync)
(server:reply return-address qry-sig #t 1)) ;; (length data)))
((set-verbosity)
(set! *verbosity* (car params))
(server:reply return-address qry-sig #t '(#t *verbosity*)))
((killserver)
(let ((hostname (car *runremote*))
(port (cadr *runremote*))
(pid (car params)))
(debug:print 0 "WARNING: Server on " hostname ":" port " going down by user request!")
(debug:print-info 1 "current pid=" (current-process-id))
(open-run-close tasks:server-deregister tasks:open-db
|
|
|
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
|
(hash-table-set! *logged-in-clients* client-key (current-seconds))
(server:reply return-address qry-sig #t '(#t "successful login"))) ;; path matches - pass! Should vet the caller at this time ...
(server:reply return-address qry-sig #f (list #f (conc "Login failed due to mismatch paths: " calling-path ", " *toppath*)))))))
((flush sync)
(server:reply return-address qry-sig #t 1)) ;; (length data)))
((set-verbosity)
(set! *verbosity* (car params))
(server:reply return-address qry-sig #t (list #t *verbosity*)))
((killserver)
(let ((hostname (car *runremote*))
(port (cadr *runremote*))
(pid (car params)))
(debug:print 0 "WARNING: Server on " hostname ":" port " going down by user request!")
(debug:print-info 1 "current pid=" (current-process-id))
(open-run-close tasks:server-deregister tasks:open-db
|