47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
+
|
configf:set-section-var
configf:var-is?
configf:write-alist
configf:write-config
find-config
getenv
mytarget
my-with-lock
nice-path
process:cmd-run->list
runconfig:read
runconfigs-get
safe-setenv
setenv
configf:eval-string-in-environment
|
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
+
+
+
+
+
-
+
|
;;======================================================================
;; parameters
;;======================================================================
;; while targets are Megatest specific they are a useful concept
(define mytarget (make-parameter #f))
;; fake locker
(define (fake-locker fname proc)(proc))
;; locking is optional, many environments don't care (e.g. running on one machine)
;; NOTE: the locker must follow the same syntax as with-dot-lock*
;; with-dot-lock* has problems if /tmp and the file being
;; locked are not on the same filesystem
;;
(define my-with-lock (make-parameter with-dot-lock*))
(define my-with-lock (make-parameter fake-locker)) ;; with-dot-lock*))
;;======================================================================
;; move debug stuff to separate module then put these back where they belong
;;======================================================================
;;======================================================================
;; lookup routines - replicated from configf
;;======================================================================
|
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
|
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
|
-
+
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
+
+
+
-
-
+
+
|
(configf:alist->config
(with-input-from-file fname read))))
;;======================================================================
;; DO THE LOCKING AROUND THE CALL
;;======================================================================
;;
(define (configf:write-alist cdat fname)
(define (configf:write-alist cdat fname #!optional (check-written #f))
;; (if (not (common:faux-lock fname))
;; (debug:print 0 *default-log-port* "INFO: NEED LOCKING ADDED HERE " fname)
((my-with-lock)
fname
(lambda ()
(let* ((dat (configf:config->alist cdat))
(res
(begin
(with-output-to-file fname ;; first write out the file
(lambda ()
(pp dat)))
;; I don't like this. It makes write-alist opaque and complicated. -mrw-
(if (file-exists? fname) ;; now verify it is readable
(if (configf:read-alist fname)
#t ;; data is good.
;; I don't like this. It makes write-alist complicated
;; move to something like write-and-verify-alist. -mrw-
(if check-written
(if (file-exists? fname) ;; now verify it is readable
(if (configf:read-alist fname)
'data-good ;; data is good.
(begin
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "deleting " fname " failed, exn=" exn)
#f)
(debug:print 0 *default-log-port* "WARNING: content " dat " for cache " fname " is not readable. Deleting generated file.")
(delete-file fname))
#f))
#f))))
|