| ︙ | | | ︙ | |
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
exn
(begin
;; (release-dot-lock fname)
(debug:print 0 "ERROR: portlogger:open-run-close failed. " proc " " params)
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 "exn=" (condition->list exn))
(if (file-exists? fname)(delete-file fname)) ;; brutally get rid of it
(print-call-chain))
(let* (;; (lock (obtain-dot-lock fname 2 9 10))
(db (portlogger:open-db fname))
(res (apply proc db params)))
(sqlite3:finalize! db)
;; (release-dot-lock fname)
res))))
|
|
|
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
exn
(begin
;; (release-dot-lock fname)
(debug:print 0 "ERROR: portlogger:open-run-close failed. " proc " " params)
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 "exn=" (condition->list exn))
(if (file-exists? fname)(delete-file fname)) ;; brutally get rid of it
(print-call-chain (current-error-port)))
(let* (;; (lock (obtain-dot-lock fname 2 9 10))
(db (portlogger:open-db fname))
(res (apply proc db params)))
(sqlite3:finalize! db)
;; (release-dot-lock fname)
res))))
|
| ︙ | | | ︙ | |
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
(define (portlogger:get-prev-used-port db)
(handle-exceptions
exn
(begin
(debug:print 0 "EXCEPTION: portlogger database probably overloaded or unreadable. If you see this message again remove /tmp/.$USER-portlogger.db")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 "exn=" (condition->list exn))
(print-call-chain)
(debug:print 0 "Continuing anyway.")
#f)
(sqlite3:fold-row
(lambda (var curr)
(or curr var curr))
#f
db
|
|
|
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
(define (portlogger:get-prev-used-port db)
(handle-exceptions
exn
(begin
(debug:print 0 "EXCEPTION: portlogger database probably overloaded or unreadable. If you see this message again remove /tmp/.$USER-portlogger.db")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 "exn=" (condition->list exn))
(print-call-chain (current-error-port))
(debug:print 0 "Continuing anyway.")
#f)
(sqlite3:fold-row
(lambda (var curr)
(or curr var curr))
#f
db
|
| ︙ | | | ︙ | |
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
(random (- 64000 lowport))))))
(handle-exceptions
exn
(begin
(debug:print 0 "EXCEPTION: portlogger database probably overloaded or unreadable. If you see this message again remove /tmp/.$USER-portlogger.db")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 "exn=" (condition->list exn))
(print-call-chain)
(debug:print 0 "Continuing anyway."))
(portlogger:take-port db portnum))
portnum))
;; set port to "released", "failed" etc.
;;
(define (portlogger:set-port db portnum value)
|
|
|
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
(random (- 64000 lowport))))))
(handle-exceptions
exn
(begin
(debug:print 0 "EXCEPTION: portlogger database probably overloaded or unreadable. If you see this message again remove /tmp/.$USER-portlogger.db")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 "exn=" (condition->list exn))
(print-call-chain (current-error-port))
(debug:print 0 "Continuing anyway."))
(portlogger:take-port db portnum))
portnum))
;; set port to "released", "failed" etc.
;;
(define (portlogger:set-port db portnum value)
|
| ︙ | | | ︙ | |
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
(handle-exceptions
exn
(begin
(debug:print 0 "EXCEPTION: portlogger database at " dbfname " probably overloaded or unreadable. Try removing it.")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(print "exn=" (condition->list exn))
(debug:print 0 " status: " ((condition-property-accessor 'sqlite3 'status) exn))
(print-call-chain))
(cond
((> numargs 1) ;; most commands
(case (string->symbol (car args)) ;; commands with two or more params
((take)(portlogger:take-port db (string->number (cadr args))))
((set) (portlogger:set-port db
(string->number (cadr args))
(caddr args))
(caddr args))
((failed)(portlogger:set-failed db (string->number (cadr args))) 'failed)))))))
(sqlite3:finalize! db)
result))
;; (print (apply portlogger:main (cdr (argv))))
|
|
|
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
(handle-exceptions
exn
(begin
(debug:print 0 "EXCEPTION: portlogger database at " dbfname " probably overloaded or unreadable. Try removing it.")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(print "exn=" (condition->list exn))
(debug:print 0 " status: " ((condition-property-accessor 'sqlite3 'status) exn))
(print-call-chain (current-error-port)))
(cond
((> numargs 1) ;; most commands
(case (string->symbol (car args)) ;; commands with two or more params
((take)(portlogger:take-port db (string->number (cadr args))))
((set) (portlogger:set-port db
(string->number (cadr args))
(caddr args))
(caddr args))
((failed)(portlogger:set-failed db (string->number (cadr args))) 'failed)))))))
(sqlite3:finalize! db)
result))
;; (print (apply portlogger:main (cdr (argv))))
|