Megatest

Check-in [a23cf8b5b9]
Login
Overview
Comment:Merged v1.65
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-ulex-try-again
Files: files | file ages | folders
SHA1: a23cf8b5b90f8030125441c7ee17443e4c5a45e7
User & Date: matt on 2020-12-17 21:23:53
Other Links: branch diff | manifest | tags
Context
2020-12-29
11:42
Merged v1.65 fixes check-in: 25464d7c31 user: matt tags: v1.65-ulex-try-again
2020-12-17
21:23
Merged v1.65 check-in: a23cf8b5b9 user: matt tags: v1.65-ulex-try-again
14:05
Turn back on aborting of server starts when there are enough running and use at to move them out of the way 10 minutes after they are created. check-in: 709d4974b2 user: mrwellan tags: v1.65
2020-12-16
23:12
Merged in v1.65, fixed Makefile and removed pkts from megatest/ulex.scm check-in: 96e98c0e2c user: matt tags: v1.65-ulex-try-again
Changes

Modified http-transport.scm from [67489ed9ab] to [8b77952676].

555
556
557
558
559
560
561
562
563

564
565


566
567

568

569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
  (let* ((tmp-area            (common:get-db-tmp-area))
	 (server-start        (conc tmp-area "/.server-start"))
	 (server-started      (conc tmp-area "/.server-started"))
	 (start-time          (common:lazy-modification-time server-start))
	 (started-time        (common:lazy-modification-time server-started))
	 (server-starting     (< start-time started-time)) ;; if start-time is less than started-time then a server is still starting
	 (start-time-old      (> (- (current-seconds) start-time) 5))
         (cleanup-proc        (lambda (msg)
                                (let* ((serv-fname      (conc "server-" (current-process-id) "-" (get-host-name) ".log"))

                                       (full-serv-fname (conc *toppath* "/logs/" serv-fname))
                                       (new-serv-fname  (conc *toppath* "/logs/" "defunct-" serv-fname)))


                                  (debug:print 0 *default-log-port* msg)
                                  (if (common:file-exists? full-serv-fname)

                                      (system (conc "sleep 1;mv -f " full-serv-fname " " new-serv-fname))

                                      (debug:print 0 *default-log-port* "INFO: cannot move " full-serv-fname " to " new-serv-fname))
                                  (exit)))))
    #;(if (and (not start-time-old) ;; last server start try was less than five seconds ago
	     (not server-starting))
	(begin
	  (cleanup-proc "NOT starting server, there is either a recently started server or a server in process of starting")
	  (exit)))
    ;; lets not even bother to start if there are already three or more server files ready to go
    #;(let* ((num-alive   (server:get-num-alive (server:get-list *toppath*))))
      (if (> num-alive 3)
          (begin
            (cleanup-proc (conc "ERROR: Aborting server start because there are already " num-alive " possible servers either running or starting up"))
            (exit))))
  (common:save-pkt `((action . start)
		     (T      . server)
		     (pid    . ,(current-process-id)))







|

>

|
>
>


>
|
>


|





|







555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
  (let* ((tmp-area            (common:get-db-tmp-area))
	 (server-start        (conc tmp-area "/.server-start"))
	 (server-started      (conc tmp-area "/.server-started"))
	 (start-time          (common:lazy-modification-time server-start))
	 (started-time        (common:lazy-modification-time server-started))
	 (server-starting     (< start-time started-time)) ;; if start-time is less than started-time then a server is still starting
	 (start-time-old      (> (- (current-seconds) start-time) 5))
         (cleanup-proc        (lambda (msg) ;; would like to use (modulo (current-seconds) 60) instead of process-id to wrap filenames
                                (let* ((serv-fname      (conc "server-" (current-process-id) "-" (get-host-name) ".log"))
				       (new-fname       (conc "server-" (modulo (current-seconds) 60) "-" (get-host-name) ".log"))
                                       (full-serv-fname (conc *toppath* "/logs/" serv-fname))
                                       ;; (new-serv-fname  (conc *toppath* "/logs/" "defunct-" serv-fname))
				       (new-serv-fname  (conc *toppath* "/logs/" new-fname))
				       )
                                  (debug:print 0 *default-log-port* msg)
                                  (if (common:file-exists? full-serv-fname)
				      (with-output-to-pipe "at now + 10 minutes" (lambda ()
										   (print "mv -f " full-serv-fname " " new-serv-fname)))
                                      ;; (system (conc "sleep 10;mv -f " full-serv-fname " " new-serv-fname))
                                      (debug:print 0 *default-log-port* "INFO: cannot move " full-serv-fname " to " new-serv-fname))
                                  (exit)))))
    (if (and (not start-time-old) ;; last server start try was less than five seconds ago
	     (not server-starting))
	(begin
	  (cleanup-proc "NOT starting server, there is either a recently started server or a server in process of starting")
	  (exit)))
    ;; lets not even bother to start if there are already three or more server files ready to go
    (let* ((num-alive   (server:get-num-alive (server:get-list *toppath*))))
      (if (> num-alive 3)
          (begin
            (cleanup-proc (conc "ERROR: Aborting server start because there are already " num-alive " possible servers either running or starting up"))
            (exit))))
  (common:save-pkt `((action . start)
		     (T      . server)
		     (pid    . ,(current-process-id)))