Megatest

Check-in [e52f8b2513]
Login
Overview
Comment:Tidy up of mtut formating
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-multi-db
Files: files | file ages | folders
SHA1: e52f8b2513cf17879f6a00d912aa445b35a45d76
User & Date: matt on 2019-02-07 10:19:15
Other Links: branch diff | manifest | tags
Context
2019-02-09
20:55
progress Leaf check-in: adbeb66c05 user: matt tags: v1.65-multi-db
2019-02-07
10:19
Tidy up of mtut formating check-in: e52f8b2513 user: matt tags: v1.65-multi-db
2019-02-06
22:24
outline of the task dispatcher coded check-in: 0c8e6ec6fd user: matt tags: v1.65-multi-db
Changes

Modified mtut.scm from [b8b7168231] to [e0feef8240].

1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645













1646
1647

1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660











1661
1662
1663
1664
1665


1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683

















1684
1685
1686


1687
1688

1689
1690

1691
1692
1693
1694
1695
1696
1697
1626
1627
1628
1629
1630
1631
1632













1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646

1647
1648
1649











1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660





1661
1662
1663

















1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681


1682
1683
1684

1685
1686

1687
1688
1689
1690
1691
1692
1693
1694







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

-
+


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

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

-
-
+
+

-
+

-
+







                       (let* ((rep       (start-nn-server portnum))
                              (mtconfdat (simple-setup (args:get-arg "-start-dir")))
                              (mtconf    (car mtconfdat))
                              (contact   (configf:lookup mtconf "listener" "owner"))
                              (script    (configf:lookup mtconf "listener" "script")))
                         (print "Listening on port " portnum " for messages.")
                         (set-signal-handler! signal/int  (lambda (signum) 
															(set! *time-to-exit* #t)
  														(debug:print-error 0 *default-log-port* "Received signal " signum " sending email befor exiting !!")
  														(let ((email-body (mtut:stml->string (s:body
																						(s:p (conc "Received signal " signum ". Lister has been terminated on host " (get-environment-variable "HOST") ". "))))))
             					        (sendmail contact "Listner has been terminated." email-body  use_html: #t))
                              (exit)))
															(set-signal-handler! signal/term  (lambda (signum) 
															(set! *time-to-exit* #t)
  														(debug:print-error 0 *default-log-port* "Received signal " signum " sending email befor exiting !!")
  														(let ((email-body (mtut:stml->string (s:body
																						(s:p (conc "Received signal " signum ". Lister has been terminated on host " (get-environment-variable "HOST") ". "))))))
             					        (sendmail contact "Listner has been terminated." email-body  use_html: #t))
                              (exit)))
							    (set! *time-to-exit* #t)
							    (debug:print-error 0 *default-log-port* "Received signal " signum " sending email befor exiting !!")
							    (let ((email-body (mtut:stml->string (s:body
												  (s:p (conc "Received signal " signum ". Lister has been terminated on host " (get-environment-variable "HOST") ". "))))))
							      (sendmail contact "Listner has been terminated." email-body  use_html: #t))
							    (exit)))
			 (set-signal-handler! signal/term  (lambda (signum) 
							     (set! *time-to-exit* #t)
							     (debug:print-error 0 *default-log-port* "Received signal " signum " sending email befor exiting !!")
							     (let ((email-body (mtut:stml->string (s:body
												   (s:p (conc "Received signal " signum ". Lister has been terminated on host " (get-environment-variable "HOST") ". "))))))
							       (sendmail contact "Listner has been terminated." email-body  use_html: #t))
							     (exit)))

                         ;(set-signal-handler! signal/term special-signal-handler)
			 ;;(set-signal-handler! signal/term special-signal-handler)
                         
                         (let loop ((instr (nn-recv rep)))
                             ;;(nn-send rep "3.9")
                             (with-input-from-pipe (conc "/usr/bin/uptime | cut -d':' -f4 | awk '{print $1}' | cut -d',' -f1")
                             	(lambda()
                             		(let loop ((inl (read-line)))
                          				(if (not (eof-object? inl))
                              				(begin
                                			;;(print "fdk73: " inl ":")
                                			;;(set! current-list-ciaf (append! current-list-ciaf (list (string-substitute "\\s+$" "" inl))))
                                			(nn-send rep inl)
                                			(loop(read-line)))
                          				))
			   ;;(nn-send rep "3.9")
			   (with-input-from-pipe (conc "/usr/bin/uptime | cut -d':' -f4 | awk '{print $1}' | cut -d',' -f1")
			     (lambda()
			       (let loop ((inl (read-line)))
				 (if (not (eof-object? inl))
				     (begin
				       ;;(print "fdk73: " inl ":")
				       ;;(set! current-list-ciaf (append! current-list-ciaf (list (string-substitute "\\s+$" "" inl))))
				       (nn-send rep inl)
				       (loop(read-line)))
				     ))))

                             	)
                             )
                             ;;(print (isys "/usr/bin/uptime" foreach-stdout-thunk: foreach-stdout))
                             (let ((ctime (date->string (current-date)))) 
			   ;;(print (isys "/usr/bin/uptime" foreach-stdout-thunk: foreach-stdout))
			   (let ((ctime (date->string (current-date)))) 
                             (if  (equal? instr "time-to-die")
                              (begin 
                              (debug:print 0 *default-log-port* ctime " received '" instr "'. Time to sucide." )
                               (let ((pid  (current-process-id)))
                              (debug:print 0 *default-log-port* "Killing current process (pid=" pid ")")
                               (system (conc "kill " pid))))  
                             (begin
								(debug:print 0 *default-log-port* ctime " received " instr )
								;(nn-send rep "ok")
                                (if (not (equal? instr "ping"))
                                  (begin
                                   (debug:print 0 *default-log-port* ctime " running \"" script " " instr "\"")
                                    ;(system (conc script " '" instr "'"))
                                      (process-run script (list  instr ))  
                                     (debug:print 0 *default-log-port* ctime " done" ))
                                   (begin
                                   	 (if (not (equal? instr "load"))
                                   	 	(print "Checking load")
				  (begin 
				    (debug:print 0 *default-log-port* ctime " received '" instr "'. Time to sucide." )
				    (let ((pid  (current-process-id)))
				      (debug:print 0 *default-log-port* "Killing current process (pid=" pid ")")
				      (system (conc "kill " pid))))  
				  (begin
				    (debug:print 0 *default-log-port* ctime " received " instr )
					;(nn-send rep "ok")
				    (if (not (equal? instr "ping"))
					(begin
					  (debug:print 0 *default-log-port* ctime " running \"" script " " instr "\"")
					;(system (conc script " '" instr "'"))
					  (process-run script (list  instr ))  
					  (debug:print 0 *default-log-port* ctime " done" ))
					(begin
					  (if (not (equal? instr "load"))
					      (print "Checking load")

                                   	 ) 
                                   )
					      ) 
					  )

                                  )
					)

                                )))
				    )))
                           (loop (nn-recv rep))))
		       (print "ERROR: Port " portnum " already in use. Try another port")))))))
      



      ((tlisten)