Overview
Comment: | server connection tag |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.64-server-connection-tagging |
Files: | files | file ages | folders |
SHA1: |
6b1258c69ac75cf326bf4190d60c7f02 |
User & Date: | mrwellan on 2017-07-12 18:36:23 |
Other Links: | branch diff | manifest | tags |
Context
2017-08-29
| ||
10:50 | Bringing in latest changes from v1.64 Closed-Leaf check-in: b1eee0709a user: mrwellan tags: v1.64-server-connection-tagging | |
2017-07-12
| ||
18:36 | server connection tag check-in: 6b1258c69a user: mrwellan tags: v1.64-server-connection-tagging | |
2017-07-11
| ||
22:43 | Better server and sync run-away protection using dot files in the users tmp db area. check-in: 3007449383 user: matt tags: v1.64, v1.6424 | |
Changes
Modified api.scm from [c4438e36a1] to [45381e3879].
︙ | |||
133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 | 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 | + + + + | (vector #f (vector #f 'overloaded))) ;; the inner vector is what gets returned. nope, don't know why. please refactor! (else (let* ((cmd-in (vector-ref dat 0)) (cmd (if (symbol? cmd-in) cmd-in (string->symbol cmd-in))) (params (vector-ref dat 1)) (server-key (if (> (vector-length dat) 1)(vector-ref dat 2) #f)) (start-t (current-milliseconds)) (readonly-mode (dbr:dbstruct-read-only dbstruct)) (readonly-command (member cmd api:read-only-queries)) (writecmd-in-readonly-mode (and readonly-mode (not readonly-command))) (res (if writecmd-in-readonly-mode (conc "attempt to run write command "cmd" on a read-only database") (if (not (equal? server-key *server-id*)) (vector #f (vector #f 'wrong-server)) (case cmd ;;=============================================== ;; READ/WRITE QUERIES ;;=============================================== ((get-keys-write) (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl |
︙ | |||
299 300 301 302 303 304 305 | 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 | - + + - + | ;; TESTMETA ((testmeta-get-record) (apply db:testmeta-get-record dbstruct params)) ;; TASKS ((find-task-queue-records) (apply tasks:find-task-queue-records dbstruct params)) (else (debug:print 0 *default-log-port* "ERROR: bad api call " cmd) |
︙ |
cgisetup/cgi-bin/models became a regular file with contents [39c07627cc].
whitespace changes only
cgisetup/cgi-bin/pages became a regular file with contents [e2b5ed002d].
whitespace changes only
Modified common.scm from [b3a2e136d0] to [43f29ee795].
︙ | |||
117 118 119 120 121 122 123 | 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | - + | ;; SERVER (define *my-client-signature* #f) (define *transport-type* 'http) ;; override with [server] transport http|rpc|nmsg (define *runremote* #f) ;; if set up for server communication this will hold <host port> ;; (define *max-cache-size* 0) (define *logged-in-clients* (make-hash-table)) |
︙ |
Modified db.scm from [08b5e15dd9] to [cb635debe0].
︙ | |||
3711 3712 3713 3714 3715 3716 3717 | 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 | - + | (list #f "Login failed due to mismatch paths: " calling-path ", " *toppath*)) ;; ((not (equal? *run-id* run-id)) ;; (list #f "Login failed due to mismatch run-id: " run-id ", " *run-id*)) ((not (equal? megatest-version calling-version)) (list #f "Login failed due to mismatch megatest version: " calling-version ", " megatest-version)) (else (hash-table-set! *logged-in-clients* client-signature (current-seconds)) |
︙ |
Modified http-transport.scm from [91f92e466a] to [cf73811734].
︙ | |||
55 56 57 58 59 60 61 | 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 | - + - - - | (hostname (get-host-name)) (ipaddrstr (let ((ipstr (if (string=? "-" hostn) ;; (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".") (server:get-best-guess-address hostname) #f))) (if ipstr ipstr hostn))) ;; hostname))) (start-port (portlogger:open-run-close portlogger:find-port)) |
︙ | |||
105 106 107 108 109 110 111 | 102 103 104 105 106 107 108 109 110 111 112 113 114 115 | - | (send-response body: "hey there!\n" headers: '((content-type text/plain)))) ((equal? (uri-path (request-uri (current-request))) '(/ "hey")) (send-response body: "hey there!\n" headers: '((content-type text/plain)))) (else (continue)))))))) |
︙ | |||
252 253 254 255 256 257 258 | 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 | - + | (mutex-unlock! *http-mutex*) ;;; (signal (make-composite-condition ;;; (make-property-condition 'commfail 'message "failed to connect to server"))) ;;; "communications failed" (db:obj->string #f)) (with-input-from-request ;; was dat fullurl |
︙ | |||
350 351 352 353 354 355 356 | 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 | - - - + | ;; used and to shutdown after sometime if it is not. ;; (define (http-transport:keep-running) ;; if none running or if > 20 seconds since ;; server last used then start shutdown ;; This thread waits for the server to come alive (debug:print-info 0 *default-log-port* "Starting the sync-back, keep alive thread in server") |
︙ | |||
384 385 386 387 388 389 390 | 378 379 380 381 382 383 384 385 386 387 388 389 390 391 | - - - | sdat))))))) (iface (car server-info)) (port (cadr server-info)) (last-access 0) (server-timeout (server:get-timeout)) (server-going #f) (server-log-file (args:get-arg "-log"))) ;; always set when we are a server |
︙ | |||
499 500 501 502 503 504 505 | 490 491 492 493 494 495 496 497 498 499 500 501 502 503 | - - - - - - - - - - - - - | (exit))) ;; all routes though here end in exit ... ;; ;; start_server? ;; (define (http-transport:launch) |
︙ | |||
536 537 538 539 540 541 542 | 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 | - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + | (thread-start! th2) (thread-sleep! 0.25) ;; give the server time to settle before starting the keep-running monitor. (thread-start! th3) (set! *didsomething* #t) (thread-join! th2) (exit))) |
︙ |
Modified server.scm from [52a482f03f] to [62d94099bf].
︙ | |||
68 69 70 71 72 73 74 | 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 | + + - + - + + + | (configf:lookup *configdat* "server" "transport") "rpc")))) (set! *transport-type* ttype) ttype))) ;; Generate a unique signature for this server (define (server:mk-signature) (if *server-id* *server-id* |
︙ | |||
407 408 409 410 411 412 413 414 415 416 417 418 419 420 | 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 | + + + + + | (server-dat (http-transport:client-connect iface port)) (login-res (rmt:login-no-auto-client-setup server-dat))) (if (and (list? login-res) (car login-res)) (begin ;; (print "LOGIN_OK") (if do-exit (exit 0)) (if (> (length login-res) 2) ;; we are expecting ( #t "message" "serversig" ) (begin (set! *server-id* (caddr login-res)) (debug:print-info 1 *default-log-port* "Connected to server " *server-id*)) (debug:print 0 *default-log-port* "ERROR: connected to server but no server signature provided.")) #t) (begin ;; (print "LOGIN_FAILED") (if do-exit (exit 1)) #f))))))) ;; run ping in separate process, safest way in some cases |
︙ |