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
		      (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))))



	    (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)))







>
>
>
|
|
|
|
|
|







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)))))))))
	
(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)))