Megatest

Check-in [c0aef35236]
Login
Overview
Comment:Partial fix for pkts creation in read-only mode. Server is attempted to start. This fix likely only kicks the can down the road as the server really should not be being started under read-only conditions IIRC
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65
Files: files | file ages | folders
SHA1: c0aef352366ca03fc684a04a26af9123a2d7f403
User & Date: mrwellan on 2017-12-13 22:01:26
Other Links: branch diff | manifest | tags
Context
2017-12-13
23:49
added rmt get-steps-info-by-id and get-test-info-by-id to readonly list added static html generation; check-in: dabd344efb user: pjhatwal tags: v1.65
22:01
Partial fix for pkts creation in read-only mode. Server is attempted to start. This fix likely only kicks the can down the road as the server really should not be being started under read-only conditions IIRC check-in: c0aef35236 user: mrwellan tags: v1.65
2017-12-12
15:27
updated manual check-in: 3eb427f66f user: bjbarcla tags: v1.65
Changes

Modified common.scm from [6661afd320] to [4cde1b58ea].

2471
2472
2473
2474
2475
2476
2477



2478
2479
2480
2481
2482
2483






2484
2485
2486
2487
2488
2489
2490
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480






2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493







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







		      (alist->pkt pktalist common:pkts-spec)))
	  (hash-table-set! *pkts-info* 'last-parent uuid)
	  (let ((pktsdir (or (hash-table-ref/default *pkts-info* 'pkts-dir #f)
			     (let* ((pktsdirs (common:get-pkts-dirs mtconf use-lt))
				    (pktsdir   (car pktsdirs))) ;; assume it is there
			       (hash-table-set! *pkts-info* 'pkts-dir pktsdir)
			       pktsdir))))
            (handle-exceptions
             exn
             (debug:print-info 0 "failed to write out packet to " pktsdir) ;; don't care if this failed for now but MUST FIX - BUG!!
	    (if (not (file-exists? pktsdir))
		(create-directory pktsdir #t))
	    (with-output-to-file
		(conc pktsdir "/" uuid ".pkt")
	      (lambda ()
		(print pkt))))))))
             (if (not (file-exists? pktsdir))
                 (create-directory pktsdir #t))
             (with-output-to-file
                 (conc pktsdir "/" uuid ".pkt")
               (lambda ()
                 (print pkt)))))))))
	
(define (common:with-queue-db mtconf proc #!key (use-lt #f)(toppath-in #f))
  (let* ((pktsdirs (common:get-pkts-dirs mtconf use-lt))
	 (pktsdir  (if pktsdirs (car pktsdirs) #f))
	 (toppath  (or (configf:lookup mtconf "scratchdat" "toppath")
		       toppath-in))
	 (pdbpath  (or (configf:lookup mtconf "setup"  "pdbpath") pktsdir)))