Megatest

Check-in [0a3812f5e3]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Portlogger almost functional
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 0a3812f5e3152100a479dc66dfb5b1c82423c8e0
User & Date: matt on 2014-08-26 23:14:10
Other Links: branch diff | manifest | tags
Context
2014-08-26
23:17
Added debug to portlogger check-in: c02687e1a4 user: matt tags: v1.60
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
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified http-transport.scm from [ef3af529b1] to [8af71ea3f3].

︙
134
135
136
137
138
139
140
141

142
143
144
145
146
147
148

134
135
136
137
138
139
140

141
142
143
144
145
146
147
148








-
+








;; This is recursively run by http-transport:run until sucessful
;;
(define (http-transport:try-start-server run-id ipaddrstr portnum server-id)
  (handle-exceptions
   exn
   (begin
     (print-error-message exn)
     (if (< portnum 9000)
     (if (< portnum 90000)
	 (begin 
	   (debug:print 0 "WARNING: failed to start on portnum: " portnum ", trying next port")
	   (thread-sleep! 0.1)

	   ;; get_next_port goes here

	   (http-transport:try-start-server run-id ipaddrstr (+ portnum 1) server-id))
︙

Modified portlogger.scm from [2dbd78141e] to [9171034404].

︙
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























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
62

63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84








+
-
-
-
-
-
-
+
+
+
+
+
+




-
-
-
+
+
+




-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

(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;")
    (if (not exists)
    (sqlite3:execute 
     db
     "CREATE TABLE ports (
        port INTEGER PRIMARY KEY,
        state TEXT DEFAULT 'not-used',
        fail_count INTEGER DEFAULT 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=?;"))
  (let* ((qry1 (sqlite3:prepare db "INSERT INTO ports (port,state) VALUES (?,?);"))
	 (qry2 (sqlite3:prepare db "UPDATE ports SET state=? WHERE port=?;"))
	 (qry3 (sqlite3:prepare db "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))))
		  (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))))
		    (print "curr=" curr " res=" res)
		    res)))))
    (sqlite3:finalize! qry1)
    (sqlite3:finalize! qry2)
    (sqlite3:finalize! qry3)
    res))
       

;; set port to "released", "failed" etc.
;; 
(define (portlogger:set-port db portnum value)
  (sqlite3:execute db "UPDATE ports SET state=? WHERE portnum=?;" value portnum))

;;======================================================================
;; MAIN
;;======================================================================

(let* ((db      (portlogger:open-db (conc "/tmp/." (current-user-name))))
       (args    (cdr (argv)))
       (numargs (length args)))
  (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))))))
  (sqlite3:finalize! db))

This page was generated in about 0.099s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00