Megatest

Check-in [ce1f2b5ce1]
Login
Overview
Comment:Added partially implemented portlogger
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: ce1f2b5ce154a0fe30632d76cacb912b5f8ef8ba
User & Date: matt on 2014-08-26 22:56:16
Other Links: branch diff | manifest | tags
Context
2014-08-26
23:14
Portlogger almost functional check-in: 0a3812f5e3 user: matt tags: v1.60
22:56
Added partially implemented portlogger check-in: ce1f2b5ce1 user: matt tags: v1.60
10:08
Cleaned up messages on server startup. Servers started only if write frequency is high. check-in: b045e9649e user: mrwellan tags: v1.60
Changes

Added portlogger.scm version [2dbd78141e].






























































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


;; Copyright 2006-2014, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

(require-extension (srfi 18) extras tcp s11n)

(use sqlite3 srfi-1 posix srfi-69 hostinfo)
(import (prefix sqlite3 sqlite3:))

;; lsof -i


(define (portlogger:open-db fname)
  (let* ((exists   (file-exists? fname))
	 (db       (sqlite3:open-database fname))
	 (handler  (make-busy-timeout 136000))
	 (canwrite (file-write-access? fname)))
    (sqlite3:set-busy-handler! db handler)
    (sqlite3:execute db "PRAGMA synchronous = 0;")
    (sqlite3:execute 
     db
     "CREATE TABLE ports (
        port INTEGER PRIMARY KEY,
        state TEXT DEFAULT 'not-used',
        fail_count INTEGER DEFAULT 0);")
    db))

;; (fold-row PROC INIT DATABASE SQL . PARAMETERS) 
(define (portlogger:take-port db portnum)
  (let* ((qry1 (sqlite3:prepare "INSERT INTO ports (port,state) VALUES (?,?);"))
	 (qry2 (sqlite3:prepare "UPDATE ports SET state=? WHERE port=?;"))
	 (qry3 (sqlite3:prepare "SELECT state FROM ports WHERE port=?;"))
	 (res  (sqlite3:with-transaction
		db
		(lambda ()
		  ;; (fold-row (lambda (var curr) (or var curr)) #f db "SELECT var FROM foo WHERE id=100;")
		  (let ((curr (sqlite3:fold-row
			       (lambda (var curr)
				 (or var curr))
			       "not-tried"
			       qry3
			       portnum))
			(res   (case (string->symbol curr)
				 ((released)  (sqlite3:execute qry2 "taken" portnum) 'taken)
				 ((not-tried) (sqlite3:execute qry1 portnum "taken") 'taken)
				 ((taken)                                            'already-taken)
				 ((failed)                                           'failed)
				 (else                                               'error))))
		    res)))))
    (sqlite3:finalize! qry1)
    (sqlite3:finalize! qry2)
    (sqlite3:finalize! qry3)
    res))