2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
|
(pktsdir (if pktsdirs (car pktsdirs) #f))
(toppath (or (configf:lookup mtconf "scratchdat" "toppath")
toppath-in))
(pdbpath (or (configf:lookup mtconf "setup" "pdbpath") pktsdir)))
(cond
((not (and pktsdir toppath pdbpath))
(debug:print 0 *default-log-port* "ERROR: settings are missing in your megatest.config for area management.")
(debug:print 0 *default-log-port* " you need to have pktsdir in the [setup] section."))
((not (common:file-exists? pktsdir))
(debug:print 0 *default-log-port* "ERROR: pkts directory not found " pktsdir))
((not (equal? (file-owner pktsdir)(current-effective-user-id)))
(debug:print 0 *default-log-port* "ERROR: directory " pktsdir " is not owned by " (current-effective-user-name)))
(else
(let* ((pdb (open-queue-db pdbpath "pkts.db"
schema: '("CREATE TABLE groups (id INTEGER PRIMARY KEY,groupname TEXT, CONSTRAINT group_constraint UNIQUE (groupname));"))))
|
|
|
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
|
(pktsdir (if pktsdirs (car pktsdirs) #f))
(toppath (or (configf:lookup mtconf "scratchdat" "toppath")
toppath-in))
(pdbpath (or (configf:lookup mtconf "setup" "pdbpath") pktsdir)))
(cond
((not (and pktsdir toppath pdbpath))
(debug:print 0 *default-log-port* "ERROR: settings are missing in your megatest.config for area management.")
(debug:print 0 *default-log-port* " you need to have pktsdirs in the [setup] section."))
((not (common:file-exists? pktsdir))
(debug:print 0 *default-log-port* "ERROR: pkts directory not found " pktsdir))
((not (equal? (file-owner pktsdir)(current-effective-user-id)))
(debug:print 0 *default-log-port* "ERROR: directory " pktsdir " is not owned by " (current-effective-user-name)))
(else
(let* ((pdb (open-queue-db pdbpath "pkts.db"
schema: '("CREATE TABLE groups (id INTEGER PRIMARY KEY,groupname TEXT, CONSTRAINT group_constraint UNIQUE (groupname));"))))
|