Megatest

Check-in [7323061194]
Login
Overview
Comment:First steps towards better archive handling
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64-better-archives
Files: files | file ages | folders
SHA1: 732306119419a6caf4adfe6d319b90e2149a09f7
User & Date: matt on 2017-07-16 20:39:17
Other Links: branch diff | manifest | tags
Context
2017-07-16
21:53
Added hierhash check-in: f4498ccf0b user: matt tags: v1.64-better-archives
20:39
First steps towards better archive handling check-in: 7323061194 user: matt tags: v1.64-better-archives
2017-07-14
17:29
removed server-start from run check-in: c0c5c1cbc3 user: bjbarcla tags: v1.64
Changes

Modified common.scm from [794fa31626] to [7e3a6d5914].

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
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











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







;;======================================================================
;; Copyright 2006-2012, 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.
;;======================================================================

(use srfi-1 data-structures posix regex-case base64 format dot-locking csv-xml z3 sql-de-lite hostinfo md5 message-digest typed-records directory-utils stack
     matchable)
(use srfi-1 data-structures posix regex-case (prefix base64 base64:)
     format dot-locking csv-xml z3 ;; sql-de-lite
(require-extension regex posix)

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

(import (prefix sqlite3 sqlite3:))
     hostinfo md5 message-digest typed-records directory-utils stack
     matchable regex posix (srfi 18) extras ;; tcp 
     (prefix nanomsg nmsg:)
     (prefix sqlite3 sqlite3:)
(import (prefix base64 base64:))
     )

(declare (unit common))

(include "common_records.scm")

;; (require-library margs)
;; (include "margs.scm")
2269
2270
2271
2272
2273
2274
2275
2276









































2277
2278
2279
2280
2281
2282
2283
2268
2269
2270
2271
2272
2273
2274

2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322







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







				    fallback-launcher
				    (loop (car tal)(cdr tal)))))))
		      ;; no match, try again
		      (if (null? tal)
			  fallback-launcher
			  (loop (car tal)(cdr tal))))))))
	fallback-launcher)))
  

;;======================================================================
;; NMSG AND NEW API
;;======================================================================

;; nm based server
;;
(define (nm:start-server dbconn #!key (given-host-name #f))
  (let* ((srvdat    (start-raw-server given-host-name: given-host-name))
	 (host-name (srvdat-host srvdat))
	 (soc       (srvdat-soc srvdat)))
    
    ;; start the queue processor (save for second round of development)
    ;;
    ;; (thread-start! (queue-processory dbconn) "Queue processor")
    ;; msg is an alist
    ;;  'r host:port  <== where to return the data
    ;;  'p params     <== data to apply the command to
    ;;  'e j|s|l      <== encoding of the params. default is s (sexp), if not specified is assumed to be default
    ;;  'c command    <== look up the function to call using this key
    ;;
    (let loop ((msg-in (nn-recv soc)))
      (if (not (equal? msg-in "quit"))
	  (let* ((dat        (decode msg-in))
		 (host-port  (alist-ref 'r dat)) ;; this is for the reverse req rep where the server is a client of the original client
		 (params     (alist-ref 'p dat))
		 (command    (let ((c (alist-ref 'c dat)))(if c (string->symbol c) #f)))
		 (all-good   (and host-port params command (hash-table-exists? *commands* command))))
	    (if all-good
		(let ((cmddat (make-qitem
			       command:   command
			       host-port: host-port
			       params:    params)))
		  (queue-push cmddat) 		;; put request into the queue
		  (nn-send soc "queued"))         ;; reply with "queued"
		(print "ERROR: BAD request " dat))
	    (loop (nn-recv soc)))))
    (nn-close soc)))
  


;;======================================================================
;; D A S H B O A R D   U S E R   V I E W S
;;======================================================================

;; first read ~/views.config if it exists, then read $MTRAH/views.config if it exists
;;
(define (common:load-views-config)

Modified mtut.scm from [1f120769b0] to [de23d29c54].

985
986
987
988
989
990
991
992


993
994
995
996
997
998
999
985
986
987
988
989
990
991

992
993
994
995
996
997
998
999
1000







-
+
+







		      (system (conc "/bin/cat " schema-file)))))
	       ((sqlite3schema)
		(let* ((install-home (common:get-install-area))
		       (schema-file  (conc install-home "/share/db/mt-sqlite3.sql")))
		  (if (common:file-exists? schema-file)
		      (system (conc "/bin/cat " schema-file)))))
	       ((junk)
		(rmt:get-keys))))))))
		(rmt:get-keys))))))
      ))

;; If HTTP_HOST is defined then we must be in the cgi environment
;; so run stml and exit
;;
(if (get-environment-variable "HTTP_HOST")
    (begin
      (stml:main #f)