Megatest

Check-in [d668d912e4]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:More license clean up (missed a whole bunch)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65
Files: files | file ages | folders
SHA1: d668d912e4bf2d89acbe50c524f72e4eaec835dd
User & Date: mrwellan on 2018-02-21 13:47:56
Other Links: branch diff | manifest | tags
Context
2018-02-21
16:57
Added license header to remaining files. check-in: 4aeb75f670 user: mrwellan tags: v1.65
13:47
More license clean up (missed a whole bunch) check-in: d668d912e4 user: mrwellan tags: v1.65
12:48
Added arch brainstorming file and a fix to the clean target. check-in: c2d166b052 user: mrwellan tags: v1.65
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified client.scm from [b8e0e236d3] to [3b6119f752]. 

1
2
3
4
5




6

7
8

9


10
11
12
13
14
15
16

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



;;======================================================================
;; C L I E N T S
;;======================================================================

(use srfi-18 extras tcp s11n srfi-1 posix regex srfi-69 hostinfo md5
     message-digest matchable spiffy uri-common intarweb http-client



|
|
>
>
>
>

>
|
|
>
|
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

;; Copyright 2006-2012, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================
;; C L I E N T S
;;======================================================================

(use srfi-18 extras tcp s11n srfi-1 posix regex srfi-69 hostinfo md5
     message-digest matchable spiffy uri-common intarweb http-client

Modified common.scm from [ded8fa3dd3] to [7382d07655]. 

1
2
3
4
5




6

7
8




9
10
11
12
13
14
15
16

;;======================================================================
;; 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 (prefix base64 base64:)
     format dot-locking csv-xml z3 ;; sql-de-lite
     hostinfo md5 message-digest typed-records directory-utils stack
     matchable regex posix (srfi 18) extras ;; tcp 
     (prefix nanomsg nmsg:)



|
|
>
>
>
>

>
|
|
>
>
>
>
|








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 file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

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

Modified configf.scm from [a0780f7710] to [af30e1aa5d]. 

1
2
3
4
5




6

7
8




9
10
11
12
13
14
15
16

;;======================================================================
;; 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.
;;======================================================================

;;======================================================================
;; Config file handling
;;======================================================================

(use regex regex-case) ;;  directory-utils)



|
|
>
>
>
>

>
|
|
>
>
>
>
|








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 file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

;;======================================================================
;; Config file handling
;;======================================================================

(use regex regex-case) ;;  directory-utils)

Modified dashboard-context-menu.scm from [6e0d3fe684] to [0a1e7c69d9]. 

1
2
3
4
5




6

7
8




9
10
11
12
13
14
15
16

;;======================================================================
;; 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.
;;======================================================================

;;======================================================================
;; implementation of context menu that pops up on
;; right click on test cell in Runs & Runs Summary Tabs
;;======================================================================




|
|
>
>
>
>

>
|
|
>
>
>
>
|








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 file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

;;======================================================================
;; implementation of context menu that pops up on
;; right click on test cell in Runs & Runs Summary Tabs
;;======================================================================

Modified dashboard-tests.scm from [531072a2c7] to [2af1eb577e]. 

1
2
3
4
5




6

7
8




9
10
11
12
13
14
15
16

;;======================================================================
;; 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.
;;======================================================================

;;======================================================================
;; Test info panel
;;======================================================================

(use format fmt)



|
|
>
>
>
>

>
|
|
>
>
>
>
|








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 file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

;;======================================================================
;; Test info panel
;;======================================================================

(use format fmt)

Modified datashare.scm from [b7e3ad1287] to [2c1663032f]. 

1
2
3
4
5




6

7
8

9


10
11
12
13
14
15
16

;; Copyright 2006-2013, 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 ssax)
(use sxml-serializer)
(use sxml-modifications)
(use regex)
(use srfi-69)
(use regex-case)



|
|
>
>
>
>

>
|
|
>
|
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

;; Copyright 2006-2013, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

(use ssax)
(use sxml-serializer)
(use sxml-modifications)
(use regex)
(use srfi-69)
(use regex-case)

Modified db_records.scm from [6d9634427c] to [d7347f8638]. 















1
2
3
4
5
6
7















;;======================================================================
;; dbstruct
;;======================================================================

;;
;; -path-|-megatest.db
;;       |-db-|-main.db

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================
;; dbstruct
;;======================================================================

;;
;; -path-|-megatest.db
;;       |-db-|-main.db

Modified env.scm from [4c3e8315cb] to [9fe24952ae]. 

1
2
3
4
5




6

7
8




9
10
11
12
13
14
15
16

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

(declare (unit env))

(use sql-de-lite) ;; srfi-1 posix regex regex-case srfi-69 srfi-18 call-with-environment-variables)

(define (env:open-db fname)



|
|
>
>
>
>

>
|
|
>
>
>
>
|








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-2013, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit env))

(use sql-de-lite) ;; srfi-1 posix regex regex-case srfi-69 srfi-18 call-with-environment-variables)

(define (env:open-db fname)

Modified fdb_records.scm from [bbb0371221] to [46b8612d29]. 















1
2
3
4
5
6
7















;; Single record for managing a filedb
;; make-vector-record "Filedb record" filedb fdb db dbpath pathcache idcache partcache
;; Filedb record
(define (make-filedb:fdb)(make-vector 5))
(define-inline (filedb:fdb-get-db          vec)    (vector-ref  vec 0))
(define-inline (filedb:fdb-get-dbpath      vec)    (vector-ref  vec 1))
(define-inline (filedb:fdb-get-pathcache   vec)    (vector-ref  vec 2))

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;; Single record for managing a filedb
;; make-vector-record "Filedb record" filedb fdb db dbpath pathcache idcache partcache
;; Filedb record
(define (make-filedb:fdb)(make-vector 5))
(define-inline (filedb:fdb-get-db          vec)    (vector-ref  vec 0))
(define-inline (filedb:fdb-get-dbpath      vec)    (vector-ref  vec 1))
(define-inline (filedb:fdb-get-pathcache   vec)    (vector-ref  vec 2))

Modified fs-transport.scm from [28e812486e] to [d1050dcefe]. 

1
2
3
4
5




6

7
8

9


10
11
12
13
14
15
16

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



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

(use sqlite3 srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest)
(import (prefix sqlite3 sqlite3:))

(use spiffy uri-common intarweb http-client spiffy-request-vars)



|
|
>
>
>
>

>
|
|
>
|
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

;; Copyright 2006-2012, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

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

(use sqlite3 srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest)
(import (prefix sqlite3 sqlite3:))

(use spiffy uri-common intarweb http-client spiffy-request-vars)

Modified ftail.scm from [9cc65f192a] to [96a7ff77a3]. 

1
2
3
4
5




6

7
8




9
10
11
12
13
14
15
16

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

(declare (unit ftail))

(module ftail
    (
     open-tail-db



|
|
>
>
>
>

>
|
|
>
>
>
>
|








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 2017, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit ftail))

(module ftail
    (
     open-tail-db

Modified genexample.scm from [5460e217c0] to [d3c1b1c11c]. 

1
2
3
4
5




6

7
8




9
10
11
12
13
14
15
16

;;======================================================================
;; 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.
;;======================================================================

(declare (unit genexample))
(use posix regex)

(define genexample:example-logpro
#<<EOF



|
|
>
>
>
>

>
|
|
>
>
>
>
|








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 file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit genexample))
(use posix regex)

(define genexample:example-logpro
#<<EOF

Modified gentargets.sh from [430721a6b7] to [c202c87561]. 

1
2















3
4
5
6

#!/bin/bash
















echo '[v1.63/tip/dev]'
echo 'x 1'
echo '[v1.64/tip/dev]'
echo 'x 1'


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

#!/bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

echo '[v1.63/tip/dev]'
echo 'x 1'
echo '[v1.64/tip/dev]'
echo 'x 1'

Modified get-config-settings.sh from [3a902c0f68] to [e5299a36bd]. 















1
2















 grep configf:lookup *.scm | sed 's/^.*:lookup//; s/^-number//; s/^ //' | grep -v '^\(section\|test-conf\|tconfig\|testconfig\|dat\|config\|views-cfgdat\)' | perl -pe 's/^\s*(\*configdat\*|configdat|mtconf)//; s/^\s+//; s/\).*$//; s/"//g' | awk '{print $1,$2}' | sort | grep -v section | sort | uniq


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

 grep configf:lookup *.scm | sed 's/^.*:lookup//; s/^-number//; s/^ //' | grep -v '^\(section\|test-conf\|tconfig\|testconfig\|dat\|config\|views-cfgdat\)' | perl -pe 's/^\s*(\*configdat\*|configdat|mtconf)//; s/^\s+//; s/\).*$//; s/"//g' | awk '{print $1,$2}' | sort | grep -v section | sort | uniq

Modified http-transport.scm from [805ca7974c] to [f419733524]. 

1
2
3
4
5




6

7
8

9


10
11
12
13
14
15
16

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



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


(use  srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest posix-extras)

(use spiffy uri-common intarweb http-client spiffy-request-vars intarweb spiffy-directory-listing)



|
|
>
>
>
>

>
|
|
>
|
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

;; Copyright 2006-2012, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

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


(use  srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest posix-extras)

(use spiffy uri-common intarweb http-client spiffy-request-vars intarweb spiffy-directory-listing)

Modified items.scm from [f3b5b35708] to [2265706948]. 

1
2
3
4
5




6

7
8

9


10
11
12
13
14
15
16

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




;; (define itemdat '((ripeness    "green ripe overripe")
;; 		     (temperature "cool medium hot")
;; 		     (season      "summer winter fall spring")))

(declare (unit items))



|
|
>
>
>
>

>
|
|
>
|
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

;; Copyright 2006-2012, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.


;; (define itemdat '((ripeness    "green ripe overripe")
;; 		     (temperature "cool medium hot")
;; 		     (season      "summer winter fall spring")))

(declare (unit items))

Modified key_records.scm from [39c7ed8168] to [0f706e37f0]. 

1
2
3
4
5




6

7
8




9
10
11
12
13
14
15
16

;;======================================================================
;; 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.
;;======================================================================

(define-inline (keys->valslots keys) ;; => ?,?,? ....
  (string-intersperse (map (lambda (x) "?") keys) ","))

;; (define-inline (keys->key/field keys . additional)
;;   (string-join (map (lambda (k)(conc k " TEXT"))



|
|
>
>
>
>

>
|
|
>
>
>
>
|








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 file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(define-inline (keys->valslots keys) ;; => ?,?,? ....
  (string-intersperse (map (lambda (x) "?") keys) ","))

;; (define-inline (keys->key/field keys . additional)
;;   (string-join (map (lambda (k)(conc k " TEXT"))

Modified launch.scm from [a20a5610e0] to [f828709706]. 

1
2
3
4
5




6

7
8

9


10
11
12
13
14
15
16

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



;;======================================================================
;; launch a task - this runs on the originating host, tests themselves
;;
;;======================================================================

(use regex regex-case base64 sqlite3 srfi-18 directory-utils posix-extras z3 call-with-environment-variables csv)



|
|
>
>
>
>

>
|
|
>
|
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

;; Copyright 2006-2017, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================
;; launch a task - this runs on the originating host, tests themselves
;;
;;======================================================================

(use regex regex-case base64 sqlite3 srfi-18 directory-utils posix-extras z3 call-with-environment-variables csv)

Modified margs.scm from [22bfa302f5] to [812fd1b225]. 

1
2
3
4




5

6
7




8
9
10
11
12
13
14
15

;; Copyright 2007-2010, 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.

(declare (unit margs))
;; (declare (uses common))

(define args:arg-hash (make-hash-table))

(define (args:get-arg arg . default)


|
|
>
>
>
>
|
>
|
|
>
>
>
>
|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

;; Copyright 2007-2010, Matthew Welland.
;;
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.


(declare (unit margs))
;; (declare (uses common))

(define args:arg-hash (make-hash-table))

(define (args:get-arg arg . default)

Modified minimt/direct.scm from [54cabed7c0] to [2dcccf845d]. 















1
2
3
4
5
6
7















;; direct API, call the db calls directly
(define rmt:create-run            (statwrap 'create-run  create-run))
(define rmt:create-step           (statwrap 'create-step create-step))
(define rmt:create-test           (statwrap 'create-test create-test))
(define rmt:get-test-id           (statwrap 'get-test-id get-test-id))
(define rmt:get-run-id            (statwrap 'get-run-id  get-run-id))
(define rmt:open-create-db        (statwrap 'open        open-create-db))

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;; direct API, call the db calls directly
(define rmt:create-run            (statwrap 'create-run  create-run))
(define rmt:create-step           (statwrap 'create-step create-step))
(define rmt:create-test           (statwrap 'create-test create-test))
(define rmt:get-test-id           (statwrap 'get-test-id get-test-id))
(define rmt:get-run-id            (statwrap 'get-run-id  get-run-id))
(define rmt:open-create-db        (statwrap 'open        open-create-db))

Modified minimt/queued.scm from [71e1ba00f3] to [922cfbae9a]. 














1
2
3
4
5
6
7















(use nanomsg defstruct srfi-18)

;;======================================================================
;; Commands
;;======================================================================


>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

(use nanomsg defstruct srfi-18)

;;======================================================================
;; Commands
;;======================================================================

Modified mlaunch.scm from [dc94b7feb1] to [5bcd34288f]. 

1
2
3
4




5

6
7

8


9
10
11
12
13
14
15

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



;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

;;======================================================================
;; MLAUNCH
;;
;;   take jobs from the given queue and keep launching them keeping


|
|
>
>
>
>

>
|
|
>
|
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

;; Copyright 2006-2014, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

;;======================================================================
;; MLAUNCH
;;
;;   take jobs from the given queue and keep launching them keeping

Modified monitor.scm from [00d6efd991] to [3df55c85ea]. 

1
2
3
4




5

6
7

8


9
10
11
12
13
14
15

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



;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking)
(import (prefix sqlite3 sqlite3:))

(declare (unit runs))


|
|
>
>
>
>

>
|
|
>
|
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

;; Copyright 2006-2012, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking)
(import (prefix sqlite3 sqlite3:))

(declare (unit runs))

Modified newdashboard.scm from [13138efda6] to [3cc17ecae4]. 

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

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

;;======================================================================
;; Copyright 2006-2016, 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 format)

(use (prefix iup iup:))

(use canvas-draw)

|

|
<

|
<
<
<
|
<
<
<
>
|
<

>
|
|
>
>
>
>
|








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-2016, Matthew Welland.
;; 
;; This file is part of Megatest.

;; 
;;     Megatest is free software: you can redistribute it and/or modify



;;     it under the terms of the GNU General Public License as published by



;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.

;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(use format)

(use (prefix iup iup:))

(use canvas-draw)

Modified oldsrc/debugger.scm from [f446c83fb1] to [0dc47fa240]. 















1
2
3
4
5
6
7















(use iup)

(define *debugger-control* #f)
(define *debugger-rownum*  0)
(define *debugger-matrix*  #f)
(define *debugger*         #f)


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

(use iup)

(define *debugger-control* #f)
(define *debugger-rownum*  0)
(define *debugger-matrix*  #f)
(define *debugger*         #f)

Modified oldsrc/multi-dboard.scm from [de11d53f46] to [8f63a105a2]. 

1
2
3
4
5




6

7
8

9


10
11
12
13
14
15
16

;;======================================================================
;; Copyright 2006-2013, 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 format numbers sql-de-lite srfi-1 posix regex regex-case srfi-69 srfi-18 call-with-environment-variables)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)




|
|
>
>
>
>

>
|
|
>
|
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;======================================================================

(use format numbers sql-de-lite srfi-1 posix regex regex-case srfi-69 srfi-18 call-with-environment-variables)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)

Modified oldsrc/nmsg-transport.scm from [b30844cb1a] to [adedc287f0]. 

1
2


3

4
5


6

7
8




9
10
11
12
13
14
15
16

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

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

(use sqlite3 srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest)
(import (prefix sqlite3 sqlite3:))

;; (use nanomsg)


>
>

>
|
<
>
>

>
|
|
>
>
>
>
|








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 file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by

;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.


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

(use sqlite3 srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest)
(import (prefix sqlite3 sqlite3:))

;; (use nanomsg)

Modified portlogger-example.scm from [bd21f0d600] to [8741b3e748]. 















1
2
3
4
















(declare (uses portlogger))

(print (apply portlogger:main (cdr (argv))))

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.


(declare (uses portlogger))

(print (apply portlogger:main (cdr (argv))))

Modified process.scm from [70c3ca9d10] to [3945f219f6]. 

1
2
3
4
5




6

7
8




9
10
11
12
13
14
15
16

;;======================================================================
;; 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.
;;======================================================================

;;======================================================================
;; Process convience utils
;;======================================================================

(use regex)



|
|
>
>
>
>

>
|
|
>
>
>
>
|








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 file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

;;======================================================================
;; Process convience utils
;;======================================================================

(use regex)

Modified records-vs-vectors-vs-coops.scm from [93fa590917] to [23e52ff68b]. 















1
2
3
4
5
6
7















;; (include "vg.scm")

;; (declare (uses vg))

(use foof-loop defstruct coops)

(defstruct obj     type fill-color angle)

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;; (include "vg.scm")

;; (declare (uses vg))

(use foof-loop defstruct coops)

(defstruct obj     type fill-color angle)

Modified records.sh from [b80709e1bc] to [1efe70350b]. 

1
2















3
4
5
6
7
8
9

#! /bin/bash
















# extents caches extents calculated on draw
# proc is called on draw and takes the obj itself as a parameter
# attrib is an alist of parameters
# libs: hash of name->lib, insts: hash of instname->inst
#
# Add -safe when doing development
#


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#! /bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

# extents caches extents calculated on draw
# proc is called on draw and takes the obj itself as a parameter
# attrib is an alist of parameters
# libs: hash of name->lib, insts: hash of instname->inst
#
# Add -safe when doing development
#

Modified rmtdb.scm from [afdb905959] to [62ddf7898c]. 

1
2
3
4
5




6

7
8




9
10
11

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




|
|
>
>
>
>

>
|
|
>
>
>
>
|



1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

;;======================================================================
;; Copyright 2006-2013, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

Modified runconfig.scm from [321959f4fb] to [05844d6f1d]. 















1
2
3
4
5
6
7















;;======================================================================
;; read a config file, loading only the section pertinent
;; to this run field1val/field2val/field3val ...
;;======================================================================

(use format directory-utils)


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================
;; read a config file, loading only the section pertinent
;; to this run field1val/field2val/field3val ...
;;======================================================================

(use format directory-utils)

Modified runs.scm from [e70616f1e5] to [f1caa0cd84]. 

1
2
3
4
5




6

7
8

9


10
11
12
13
14
15
16

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



;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) 
     posix-extras directory-utils pathname-expand typed-records format)

(declare (unit runs))



|
|
>
>
>
>

>
|
|
>
|
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

;; Copyright 2006-2016, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) 
     posix-extras directory-utils pathname-expand typed-records format)

(declare (unit runs))

Modified sauth-common.scm from [b29dfd627c] to [b3f1e39c19]. 















1
2
3
4
5
6
7
















;; Create the sqlite db
(define (sauthorize:db-do proc) 
      (if (or (not *db-path*)
              (not (file-exists? *db-path*))) 
	(begin
	  (print 0 "[database]\nlocation " *db-path* " \n\n Is missing from the config file!")

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.


;; Create the sqlite db
(define (sauthorize:db-do proc) 
      (if (or (not *db-path*)
              (not (file-exists? *db-path*))) 
	(begin
	  (print 0 "[database]\nlocation " *db-path* " \n\n Is missing from the config file!")

Modified sdb.scm from [87ccf30107] to [3f78d1737e]. 

1
2
3
4
5




6

7
8




9
10
11
12
13
14
15
16

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

;;======================================================================
;; Simple persistant strings lookup table. Keep out of the main db
;; so writes/reads don't slow down central access.
;;======================================================================




|
|
>
>
>
>

>
|
|
>
>
>
>
|








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-2013, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

;;======================================================================
;; Simple persistant strings lookup table. Keep out of the main db
;; so writes/reads don't slow down central access.
;;======================================================================

Modified sharedat.scm from [aee689d39a] to [bb858ca5c8]. 

1
2
3
4
5




6

7
8




9
10
11
12
13
14
15
16

;; Copyright 2006-2013, 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 defstruct)

;; (use ssax)
;; (use sxml-serializer)
;; (use sxml-modifications)
;; (use regex)



|
|
>
>
>
>

>
|
|
>
>
>
>
|








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-2013, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.


(use defstruct)

;; (use ssax)
;; (use sxml-serializer)
;; (use sxml-modifications)
;; (use regex)

Modified spublish.scm from [c3ed2ff859] to [ea3284440b]. 

1
2
3
4
5




6

7
8

9


10
11
12
13
14
15
16

;; Copyright 2006-2013, 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 defstruct)
(use scsh-process)
(use refdb)
(use srfi-18)
(use srfi-19)
(use format)



|
|
>
>
>
>

>
|
|
>
|
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

;; Copyright 2006-2013, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

(use defstruct)
(use scsh-process)
(use refdb)
(use srfi-18)
(use srfi-19)
(use format)

Modified subrun.scm from [5a34831075] to [f622aaf2d4]. 

1
2
3
4
5




6

7
8

9


10
11
12
13
14
15
16

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



;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) 
     posix-extras directory-utils pathname-expand typed-records format
     call-with-environment-variables)
(declare (unit subrun))



|
|
>
>
>
>

>
|
|
>
|
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

;; Copyright 2006-2016, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) 
     posix-extras directory-utils pathname-expand typed-records format
     call-with-environment-variables)
(declare (unit subrun))

Modified task_records.scm from [9c8b281be4] to [ff61a823b3]. 

1
2
3
4
5




6

7
8

9


10
11
12
13
14
15
16

;;======================================================================
;; 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.


;;======================================================================

;; make-vector-record tasks task id action owner state target name test item params creation_time execution_time 
(define (make-tasks:task)(make-vector 11))
(define-inline (tasks:task-get-id               vec)    (vector-ref  vec 0))
(define-inline (tasks:task-get-action           vec)    (vector-ref  vec 1))
(define-inline (tasks:task-get-owner            vec)    (vector-ref  vec 2))



|
|
>
>
>
>

>
|
|
>
|
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;======================================================================

;; make-vector-record tasks task id action owner state target name test item params creation_time execution_time 
(define (make-tasks:task)(make-vector 11))
(define-inline (tasks:task-get-id               vec)    (vector-ref  vec 0))
(define-inline (tasks:task-get-action           vec)    (vector-ref  vec 1))
(define-inline (tasks:task-get-owner            vec)    (vector-ref  vec 2))

Modified tcmt.scm from [75ab8b7c92] to [17579f1f87]. 

1
2
3
4




5

6
7
8
9



10
11
12
13
14
15
16

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



;;======================================================================
;;
;; Wrapper to enable running Megatest flows under teamcity
;;
;;  1. Run the megatest process and pass it all the needed parameters
;;  2. Every five seconds check for state/status changes and print the info
;;


|
|
>
>
>
>

>
|
|
|
|
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

;; Copyright 2006-2017, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================
;;
;; Wrapper to enable running Megatest flows under teamcity
;;
;;  1. Run the megatest process and pass it all the needed parameters
;;  2. Every five seconds check for state/status changes and print the info
;;

Modified test_records.scm from [9245906f33] to [7ec9587d28]. 















1
2
3
4
5
6
7















;; make-vector-record tests testqueue testname testconfig waitons priority items
(define (make-tests:testqueue)(make-vector 7 #f))
(define-inline (tests:testqueue-get-testname     vec)    (vector-ref  vec 0))
(define-inline (tests:testqueue-get-testconfig   vec)    (vector-ref  vec 1))
(define-inline (tests:testqueue-get-waitons      vec)    (vector-ref  vec 2))
(define-inline (tests:testqueue-get-priority     vec)    (vector-ref  vec 3))
;; items: #f=no items, list=list of items remaining, proc=need to call to get items

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;; make-vector-record tests testqueue testname testconfig waitons priority items
(define (make-tests:testqueue)(make-vector 7 #f))
(define-inline (tests:testqueue-get-testname     vec)    (vector-ref  vec 0))
(define-inline (tests:testqueue-get-testconfig   vec)    (vector-ref  vec 1))
(define-inline (tests:testqueue-get-waitons      vec)    (vector-ref  vec 2))
(define-inline (tests:testqueue-get-priority     vec)    (vector-ref  vec 3))
;; items: #f=no items, list=list of items remaining, proc=need to call to get items

Modified tests/ods-test.scm from [08da0f4575] to [2c992ac6c5]. 















1
2
3
4
5
6
7















(load "ods.scm")

(ods:list->ods 
 "testing"
 "testing.ods"
  '((Sheet1 ("Row 1,A" "Row 1,B")
 	   ("Row 2,A" "Row 2,B"))

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

(load "ods.scm")

(ods:list->ods 
 "testing"
 "testing.ods"
  '((Sheet1 ("Row 1,A" "Row 1,B")
 	   ("Row 2,A" "Row 2,B"))

Modified trackback.scm from [4011884617] to [99c1b5dc83]. 















1
2
3
4
5
6
7















(include "codescanlib.scm")

;; show call paths for named procedure
(define (traceback-proc in-procname)
  (letrec* ((all-scm-files (glob "*.scm"))
            (xref (get-xref all-scm-files))
            (have (alist-ref (string->symbol in-procname) xref eq? #f))

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

(include "codescanlib.scm")

;; show call paths for named procedure
(define (traceback-proc in-procname)
  (letrec* ((all-scm-files (glob "*.scm"))
            (xref (get-xref all-scm-files))
            (have (alist-ref (string->symbol in-procname) xref eq? #f))

Modified utils/Makefile.git.installall from [d86762fc72] to [a36c19bd4e]. 

1
2
3



4
5


6

7
8
9



10
11
12
13
14
15
16

# Copyright 2013-2015 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.




help :
	@echo You may need to do the following setup first:
	@echo
	@echo sudo apt-get install libreadline-dev
	@echo sudo apt-get install libwebkitgtk-dev libfreetype6-dev libx11-dev libxpm-dev libxmu-dev \
	           libxft-dev libgtk2.0-dev libgl1-mesa-dev libglu1-mesa-dev libpangox-1.0-dev bison \


|
>
>
>
|
<
>
>

>
|
|
|
>
>
>








1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

# Copyright 2013-2015 Matthew Welland.
#
# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by

#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

help :
	@echo You may need to do the following setup first:
	@echo
	@echo sudo apt-get install libreadline-dev
	@echo sudo apt-get install libwebkitgtk-dev libfreetype6-dev libx11-dev libxpm-dev libxmu-dev \
	           libxft-dev libgtk2.0-dev libgl1-mesa-dev libglu1-mesa-dev libpangox-1.0-dev bison \

Modified utils/Makefile.installall from [d681455015] to [98a3761faa]. 

1
2
3



4
5


6

7
8
9



10
11
12
13
14
15
16

# Copyright 2013-2015 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.




help :
	@echo You may need to do the following setup first:
	@echo
	@echo sudo apt-get install libreadline-dev
	@echo sudo apt-get install libwebkitgtk-dev libfreetype6-dev libx11-dev libxpm-dev libxmu-dev \
	           libxft-dev libgtk2.0-dev libgl1-mesa-dev libglu1-mesa-dev libpangox-1.0-dev bison \



>
>
>
|
<
>
>

>
|
|
|
>
>
>








1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

# Copyright 2013-2015 Matthew Welland.
# 
# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by

#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

help :
	@echo You may need to do the following setup first:
	@echo
	@echo sudo apt-get install libreadline-dev
	@echo sudo apt-get install libwebkitgtk-dev libfreetype6-dev libx11-dev libxpm-dev libxmu-dev \
	           libxft-dev libgtk2.0-dev libgl1-mesa-dev libglu1-mesa-dev libpangox-1.0-dev bison \

Modified utils/Makefile.latest.installall from [e858ad0d21] to [dc72026b09]. 

1
2
3



4
5


6

7
8




9
10
11
12
13
14
15
16

# Copyright 2013-2015 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.

help :
	@echo You may need to do the following setup first:
	@echo
	@echo sudo apt-get install libreadline-dev
	@echo sudo apt-get install libwebkitgtk-dev libfreetype6-dev libx11-dev libxpm-dev libxmu-dev \
	           libxft-dev libgtk2.0-dev libgl1-mesa-dev libglu1-mesa-dev libpangox-1.0-dev bison \



>
>
>
|
<
>
>

>
|
|
>
>
>
>
|








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 2013-2015 Matthew Welland.
# 
# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by

#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.


help :
	@echo You may need to do the following setup first:
	@echo
	@echo sudo apt-get install libreadline-dev
	@echo sudo apt-get install libwebkitgtk-dev libfreetype6-dev libx11-dev libxpm-dev libxmu-dev \
	           libxft-dev libgtk2.0-dev libgl1-mesa-dev libglu1-mesa-dev libpangox-1.0-dev bison \

Modified utils/checkPreReqs from [d13b8d802c] to [073e0b79f9]. 

1
















2
3
4
5
6
7
8

#!/bin/bash
















SYSTEM_TYPE=$(lsb_release -irs |tr ' ' '_' |tr '\n' '-')$(uname -i)
file=`/bin/mktemp`
case $SYSTEM_TYPE in
Ubuntu-17.04-x86_64-std)
	apt list --installed | cut -d/ -f 1 > $file
        ;;
Ubuntu-16.04-x86_64)

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

SYSTEM_TYPE=$(lsb_release -irs |tr ' ' '_' |tr '\n' '-')$(uname -i)
file=`/bin/mktemp`
case $SYSTEM_TYPE in
Ubuntu-17.04-x86_64-std)
	apt list --installed | cut -d/ -f 1 > $file
        ;;
Ubuntu-16.04-x86_64)

Modified utils/cleanup-links-dir.sh from [2e6a90f3c8] to [6ef15fff8b]. 

1
2















3
4
5
6
7
8
9

#!/usr/bin/env bash
















export LINKSDIR=$1
export RUNSDIR=$2

if [ "x$LINKSDIR" == "x" ];then
   echo Usage: cleanup-links-dir /links/dir/path /runs/dir/path
   exit
fi


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/usr/bin/env bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

export LINKSDIR=$1
export RUNSDIR=$2

if [ "x$LINKSDIR" == "x" ];then
   echo Usage: cleanup-links-dir /links/dir/path /runs/dir/path
   exit
fi

Modified utils/cleanup-pkts.sh from [4166ea994c] to [959de99a1c]. 

1
2















3
4
5
6
7
8
9

#!/bin/bash
















pushd $1

for x in *.pkt;do
    if grep 'T configf' $x > /dev/null;then
        rm $x
    else
        echo skip $x


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

pushd $1

for x in *.pkt;do
    if grep 'T configf' $x > /dev/null;then
        rm $x
    else
        echo skip $x

Modified utils/deploy.sh from [614579fd81] to [b711663dc8]. 

1
2















3
4
5
6
7
8
9

#!/bin/bash
















set -x

if [[ $DEPLOYTARG == "" ]] ; then
    echo Installing into deploytarg
    export DEPLOYTARG=$PWD/deploytarg
fi



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

set -x

if [[ $DEPLOYTARG == "" ]] ; then
    echo Installing into deploytarg
    export DEPLOYTARG=$PWD/deploytarg
fi

Modified utils/editwiki from [14b0c3cc25] to [60a6e302de]. 

1
2















3
4
5
6
7
8
9

#!/bin/bash
















wikiname=$1
FOSSILBIN=fossil

if [ x"$wikiname" == "x" ];then
  echo "Usage: viwiki wikipagename"
  exit
fi


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

wikiname=$1
FOSSILBIN=fossil

if [ x"$wikiname" == "x" ];then
  echo "Usage: viwiki wikipagename"
  exit
fi

Modified utils/find-unused-globals.sh from [54735d591a] to [f9771fc47b]. 

1
2















3
4
5
6
7
8
9

#!/bin/bash
















echo "Finding unused globals:"

for var in $(egrep '^\s*\(define\s+\*' *.scm|awk '{print $2}'|sort -u);do
    if ! $(egrep -v '^\s*\(define' *scm| grep "$var" > /dev/null);then
	echo "$var not used";
    fi;
done


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

echo "Finding unused globals:"

for var in $(egrep '^\s*\(define\s+\*' *.scm|awk '{print $2}'|sort -u);do
    if ! $(egrep -v '^\s*\(define' *scm| grep "$var" > /dev/null);then
	echo "$var not used";
    fi;
done

Modified utils/homehost_check.sh from [a5c58a17c8] to [c621180388]. 

1
2















3
4
5
6
7
8
9

#! /bin/bash
















#exits 1 when current host is not homehost.

if [[ ! -e .homehost ]]; then
    exit 0
fi

homehostname=$( host `cat .homehost` | awk '{print $NF}' | sed 's/\.$//' )


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#! /bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

#exits 1 when current host is not homehost.

if [[ ! -e .homehost ]]; then
    exit 0
fi

homehostname=$( host `cat .homehost` | awk '{print $NF}' | sed 's/\.$//' )

Modified utils/installall.logpro from [8a1c71a14c] to [a8f269fddf]. 

1
2










3



4
5
6
7
8
9
10

;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com
;;  










;;   License GPL.




;; first ensure your run at least started
;;

(trigger "Body"     #/^.*$/) ;; anything starts the body
;; (trigger "EndBody"  #/This had better never match/)
(section "Body"     "Body" "EndBody")


>
>
>
>
>
>
>
>
>
>
|
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com
;;  
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;; first ensure your run at least started
;;

(trigger "Body"     #/^.*$/) ;; anything starts the body
;; (trigger "EndBody"  #/This had better never match/)
(section "Body"     "Body" "EndBody")

Modified utils/installall.sh from [62802dad6a] to [f674f29713]. 

1
2
3
4
5
6
7
8
9



10
11


12

13
14
15



16
17
18
19
20
21
22

#! /usr/bin/env bash

# This file installs prerequisites for megatest (chicken, eggs, etc.)
# Before running this script, set PREFIX environment variable
# to chicken install target area.  /opt/chicken is a typical value
# set -x

# Copyright 2007-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.




# echo OPTION=$OPTION

# BKM for ubuntu 17.04:
#  sudo dpkg -i libpng12-0_1.2.54-1ubuntu1_amd64.deb
#  sudo dpkg -i libpng12-0_1.2.54-1ubuntu1_amd64.deb










>
>
>
|
<
>
>

>
|
|
|
>
>
>








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

#! /usr/bin/env bash

# This file installs prerequisites for megatest (chicken, eggs, etc.)
# Before running this script, set PREFIX environment variable
# to chicken install target area.  /opt/chicken is a typical value
# set -x

# Copyright 2007-2014, Matthew Welland.
# 
# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by

#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

# echo OPTION=$OPTION

# BKM for ubuntu 17.04:
#  sudo dpkg -i libpng12-0_1.2.54-1ubuntu1_amd64.deb
#  sudo dpkg -i libpng12-0_1.2.54-1ubuntu1_amd64.deb

Modified utils/installck.sh from [7eb094e9b0] to [48b8bc3ef3]. 

1
2















3
4
5
6
7
8
9

#!/bin/bash
















myhome=$(dirname $0)

if [[ $proxy == "" ]]; then 
  echo 'Please set the environment variable "proxy" to host.com:port (e.g. foo.com:1234) to use a proxy'
  echo PROX=""
else
  export http_proxy=http://$proxy


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

myhome=$(dirname $0)

if [[ $proxy == "" ]]; then 
  echo 'Please set the environment variable "proxy" to host.com:port (e.g. foo.com:1234) to use a proxy'
  echo PROX=""
else
  export http_proxy=http://$proxy

Modified utils/loadrunner from [ba6e3962e1] to [65b681c599]. 

1
2















3
4
5
6
7
8
9

#!/bin/bash 
















LOADRUNNER=$0

# load=`uptime|awk '{print $10}'|cut -d, -f1`
load=$(uptime|perl -pe 's/.*: (\d+.\d+),.*/$1/')
load2=$(uptime|perl -pe 's/.*: (\d+.\d+), (\d+.\d+),.*/$2/')
# echo "load2=$load2, load=$load"



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash 

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

LOADRUNNER=$0

# load=`uptime|awk '{print $10}'|cut -d, -f1`
load=$(uptime|perl -pe 's/.*: (\d+.\d+),.*/$1/')
load2=$(uptime|perl -pe 's/.*: (\d+.\d+), (\d+.\d+),.*/$2/')
# echo "load2=$load2, load=$load"

Modified utils/loadrunner.scm.notfinished from [a8651ba3f3] to [110a1f3c3c]. 

1
2
3
4
5




6

7
8

9


10
11
12
13
14
15
16

;; Copyright 2006-2013, 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 ssax)
(use sxml-serializer)
(use sxml-modifications)
(use regex)
(use srfi-69)
(use regex-case)



|
|
>
>
>
>

>
|
|
>
|
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

;; Copyright 2006-2013, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

(use ssax)
(use sxml-serializer)
(use sxml-modifications)
(use regex)
(use srfi-69)
(use regex-case)

Modified utils/lock-stats.sh from [84d255afaf] to [b9c8ebf3f2]. 

1
2















3
4
5
6
7
8
9

#!/bin/bash
















while IFS=': ' read x x x x p x x i x; do
    if ! [[ ${i}x == "x" ]];then
	if ! $(echo $i|grep EOF >/dev/null);then
	    fname=$(find -L "/proc/$p/fd" -maxdepth 1 -inum "$i" -exec readlink {} \; -quit)
	    if $(echo $fname | grep megatest.db > /dev/null) || \
	       $(echo $fname | egrep '.db/\d+.db' > /dev/null);then
		echo $fname


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

while IFS=': ' read x x x x p x x i x; do
    if ! [[ ${i}x == "x" ]];then
	if ! $(echo $i|grep EOF >/dev/null);then
	    fname=$(find -L "/proc/$p/fd" -maxdepth 1 -inum "$i" -exec readlink {} \; -quit)
	    if $(echo $fname | grep megatest.db > /dev/null) || \
	       $(echo $fname | egrep '.db/\d+.db' > /dev/null);then
		echo $fname

Modified utils/mk_wrapper from [3b78e9fde2] to [5902e7d1e5]. 

1
2















3
4
5
6
7
8
9

#!/bin/bash
















prefix=$1
cmd=$2
target=$3
cfgfile="$prefix/bin/.$(lsb_release -sr)/cfg.sh"

if [ "$LD_LIBRARY_PATH" != "" ];then
  echo "INFO: Using LD_LIBRARY_PATH=$LD_LIBRARY_PATH" >&2


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

prefix=$1
cmd=$2
target=$3
cfgfile="$prefix/bin/.$(lsb_release -sr)/cfg.sh"

if [ "$LD_LIBRARY_PATH" != "" ];then
  echo "INFO: Using LD_LIBRARY_PATH=$LD_LIBRARY_PATH" >&2

Modified utils/mt_ezstep from [6865452478] to [431c4b2cc0]. 

1
2















3
4
5
6
7
8
9

#!/bin/bash
















usage="mt_ezstep stepname prevstepname command [args ...]"

if [[ "$MT_CMDINFO" == "" ]];then
  if [[ -e megatest.sh ]];then
    source megatest.sh
  else
    echo "ERROR: $0 should be run within a megatest test environment"


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

usage="mt_ezstep stepname prevstepname command [args ...]"

if [[ "$MT_CMDINFO" == "" ]];then
  if [[ -e megatest.sh ]];then
    source megatest.sh
  else
    echo "ERROR: $0 should be run within a megatest test environment"

Modified utils/mt_laststep from [b984c38ecb] to [edb9b0d531]. 

1
2















3
4
5
6
7
8
9

#!/bin/bash
















if [ $MT_CMDINFO == "" ];then
  echo "ERROR: $0 should be run within a megatest test environment"
  exit
fi

# Purpose: run a step, record start and end with exit codes, if sucessful
# update test status with PASS, else update with FAIL


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

if [ $MT_CMDINFO == "" ];then
  echo "ERROR: $0 should be run within a megatest test environment"
  exit
fi

# Purpose: run a step, record start and end with exit codes, if sucessful
# update test status with PASS, else update with FAIL

Modified utils/mt_runstep from [35ded54591] to [c328fc41d6]. 

1
2















3
4
5
6
7
8
9

#!/bin/bash
















# Purpose: run a step, record start and end with exit codes
#
# Call like this:
# mt_runstep stepname command ....
# 
# This expects that you have a logpro file named stepname.logpro and must be run
# inside a test environment (click on xterm button on a test control panel


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

# Purpose: run a step, record start and end with exit codes
#
# Call like this:
# mt_runstep stepname command ....
# 
# This expects that you have a logpro file named stepname.logpro and must be run
# inside a test environment (click on xterm button on a test control panel

Modified utils/mt_xterm from [40d98efdc8] to [838f7f03df]. 

1
2















3
4
5
6
7
8
9

#!/bin/bash
















MT_TMPDISPLAY=$DISPLAY
if [ -e megatest.sh ];then
  source megatest.sh
fi
export DISPLAY=$MT_TMPDISPLAY

if [ x"$MT_XTERM_CMD" == "x" ];then


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

MT_TMPDISPLAY=$DISPLAY
if [ -e megatest.sh ];then
  source megatest.sh
fi
export DISPLAY=$MT_TMPDISPLAY

if [ x"$MT_XTERM_CMD" == "x" ];then

Modified utils/mtgetfile from [071134089a] to [6c34d55841]. 

1
2















3
4
5
6
7
8
9

#!/bin/bash
















fullparams="$@"

function findfile () {
megatest $fullparams -repl <<EOF
(let* ((numargs (length remargs))
       (path    (if (> numargs 0)(car remargs)  #f))
       (scriptn (if (> numargs 1)(cadr remargs) #f))


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

fullparams="$@"

function findfile () {
megatest $fullparams -repl <<EOF
(let* ((numargs (length remargs))
       (path    (if (> numargs 0)(car remargs)  #f))
       (scriptn (if (> numargs 1)(cadr remargs) #f))

Modified utils/mtrept.sh from [b1e7f25939] to [ca771a03a8]. 

1
2















3
4
5
6
7
8
9

#!/bin/bash
#















# Rollup counts of calls to Megatest from a logging dat file
#
# Usage: mtrept.sh file [host]

if [[ "$2"x != "x" ]];then
  host_name_grep="grep $2 | "
else


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash
#
# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

# Rollup counts of calls to Megatest from a logging dat file
#
# Usage: mtrept.sh file [host]

if [[ "$2"x != "x" ]];then
  host_name_grep="grep $2 | "
else

Modified utils/mtrunner from [ee53d3f91b] to [3987b4602f]. 

1
2















3
4
5
6
7
8
9

#! /bin/bash
















# Run megatest from within megatest
# Usage: mtrunner testsuite_dir megatest_bin_dir command args ....

for var in $(env | egrep "^MT_"|cut -d= -f1);do
  unset ${var}
done
cd $1


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#! /bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

# Run megatest from within megatest
# Usage: mtrunner testsuite_dir megatest_bin_dir command args ....

for var in $(env | egrep "^MT_"|cut -d= -f1);do
  unset ${var}
done
cd $1

Modified utils/mtrunscript from [e78e46f29a] to [1a61a1f2c4]. 

1
2
3
4



5
6


7

8
9
10
11
12


13
14
15
16
17
18
19

#!/usr/bin/env bash

# Copyright 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.
#
# VERSION: 



# set -e
# set -u
# set -x

# Usage: mtrunscript scriptname params
#



|
>
>
>
|
<
>
>
|
>
|
|
|
|
<
>
>








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

#!/usr/bin/env bash

# Copyright 2012, Matthew Welland.

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by

#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 

#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

# set -e
# set -u
# set -x

# Usage: mtrunscript scriptname params
#

Modified utils/mtutils.csh from [23f4997ab4] to [2efb30a09e]. 

1
2
3















4
5
6
7
8
9
10

# Better to use the mt_* snippet scripts in utils 
#   To use the snippets set PREFIX then install with "make installall"
















alias mt_runstep 'set argv=(\!*); \
 set stepname = $1;shift; \
 megatest -runstep $stepname -logpro ${stepname}.logpro "$*" || exit $?'

alias mt_laststep 'set argv=(\!*);set stepname = $1;shift; \
 megatest -runstep $stepname -logpro ${stepname}.logpro "$*" ; \
 set exitstatus = $? ; \



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








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

# Better to use the mt_* snippet scripts in utils 
#   To use the snippets set PREFIX then install with "make installall"

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

alias mt_runstep 'set argv=(\!*); \
 set stepname = $1;shift; \
 megatest -runstep $stepname -logpro ${stepname}.logpro "$*" || exit $?'

alias mt_laststep 'set argv=(\!*);set stepname = $1;shift; \
 megatest -runstep $stepname -logpro ${stepname}.logpro "$*" ; \
 set exitstatus = $? ; \

Modified utils/nbfake from [bfff85f08b] to [93724ffeda]. 

1
















2
3
4
5
6
7
8

#!/bin/bash
















###############################################################################
#
# nbfake - capture command output in a logfile
#
# nbfake behavior can be changed by setting the following env vars:
#   NBFAKE_HOST       SSH to $NBFAKE_HOST and run command
#   NBFAKE_LOG        Logfile for nbfake output

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

###############################################################################
#
# nbfake - capture command output in a logfile
#
# nbfake behavior can be changed by setting the following env vars:
#   NBFAKE_HOST       SSH to $NBFAKE_HOST and run command
#   NBFAKE_LOG        Logfile for nbfake output

Modified utils/nbfind from [03c58ee4f1] to [70ee171025]. 

1
2















3
4
5
6
7
8
9

#!/bin/bash 
















# load=`uptime|awk '{print $10}'|cut -d, -f1`
load=`uptime|perl -pe 's/.*: (\d+.\d+),.*/$1/'`
if which cpucheck > /dev/null;then
    numcpu=`cpucheck|tail -1|awk '{print $6}'`
else
    numcpu=`lscpu|grep "CPU.s.:"|awk '{print $2}'`
fi


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash 

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

# load=`uptime|awk '{print $10}'|cut -d, -f1`
load=`uptime|perl -pe 's/.*: (\d+.\d+),.*/$1/'`
if which cpucheck > /dev/null;then
    numcpu=`cpucheck|tail -1|awk '{print $6}'`
else
    numcpu=`lscpu|grep "CPU.s.:"|awk '{print $2}'`
fi

Modified utils/remrun from [836fc55fdd] to [5637253c81]. 

1
2
3
4
5
6
7
8
9
10















11
12
13
14
15
16
17

#!/bin/bash
###############################################################################
#
# remrun - same behavior as nbfake but first param is a hosthane
#          (capture command output in a logfile)
#
# remrun behavior can be changed by setting the following env var:
#   NBFAKE_LOG        Logfile for nbfake output
#
###############################################################################
















if [[ -z "$@" ]]; then
  cat <<__EOF

remrun usage:

remrun hostname <command to run>










>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








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

#!/bin/bash
###############################################################################
#
# remrun - same behavior as nbfake but first param is a hosthane
#          (capture command output in a logfile)
#
# remrun behavior can be changed by setting the following env var:
#   NBFAKE_LOG        Logfile for nbfake output
#
###############################################################################
#
# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

if [[ -z "$@" ]]; then
  cat <<__EOF

remrun usage:

remrun hostname <command to run>

Modified utils/runner from [229dc9c405] to [dc2634a4ff]. 

1
2















3
4
5
6
7
8
9

#!/usr/bin/perl -w
















$starthr=`date +%k`;
$hrsper = 1;
$nexthr=$starthr + $hrsper;

$ltr='a';

while (1) {


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/usr/bin/perl -w

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

$starthr=`date +%k`;
$hrsper = 1;
$nexthr=$starthr + $hrsper;

$ltr='a';

while (1) {

Deleted utils/trace/trace.import.scm version [937dcb55c1]. 

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

;;;; trace.import.scm - GENERATED BY CHICKEN 4.9.0.1 -*- Scheme -*-

(eval '(import
         scheme
         chicken
         csi
         advice
         extras
         ports
         data-structures
         (except srfi-1 break)
         miscmacros))
(##sys#register-compiled-module
  'trace
  (list)
  '((breakpoint . trace#breakpoint)
    (trace . trace#trace)
    (untrace . trace#untrace)
    (break . trace#break)
    (unbreak . trace#unbreak)
    (trace-output-port . trace#trace-output-port)
    (continue . trace#continue)
    (c . trace#c)
    (traced? . trace#traced?)
    (trace-module . trace#trace-module)
    (untrace-module . trace#untrace-module)
    (trace-verbose . trace#trace-verbose)
    (trace/untrace . trace#trace/untrace))
  (list)
  (list))

;; END OF FILE

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

Deleted utils/trace/trace.meta version [9714181a62]. 

1
2
3
4
5
6
7
8
9
10

;;;; trace.meta -*- Scheme -*-


((category tools)
 (synopsis "tracing and breakpoints")
 (author "felix winkelmann")
 (license "public domain")
 (needs advice				; don't we all?
	miscmacros)
 (files "tests/run.scm" "trace.meta" "trace.release-info" "trace.scm" "trace.setup") )

<
<
<
<
<
<
<
<
<
<

Deleted utils/trace/trace.scm version [dc3560e035]. 

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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259

;;;; trace.scm


(module trace (breakpoint 
	       trace untrace
	       break unbreak
	       trace-output-port
	       continue c 
	       traced?
	       trace-module untrace-module
	       trace-verbose
	       trace/untrace)
	       
(import scheme chicken csi)

(use advice extras ports data-structures)
(require-library srfi-1)
(import (except srfi-1 break) miscmacros)


(define *last-breakpoint* #f)
(define *traced-procedures* '())
(define *broken-procedures* '())
(define *trace-indent-level* 0)

(define trace-output-port (make-parameter (current-output-port)))
(define trace-verbose (make-parameter #t))

(define (break-entry name args)
  ;; Does _not_ unwind!
  (##sys#call-with-current-continuation
   (lambda (c)
     (let ((exn (##sys#make-structure
		 'condition
		 '(exn breakpoint)
		 (list '(exn . message) "*** breakpoint ***"
		       '(exn . arguments) (list (cons name args))
		       '(exn . location) name
		       '(exn . continuation) c) ) ) )
       (set! *last-breakpoint* exn)
       (signal exn) ) ) ) )

(define (break-resume exn)
  (let ((a (member '(exn . continuation) (##sys#slot exn 2))))
    (if a
	((cadr a) (void))
	(error "condition has no continuation" exn) ) ) )

(define (breakpoint #!optional (name 'breakpoint))
  (break-entry name '()) )

(define (trace-indent)
  (let ((port (trace-output-port)))
    (do ((i (fxmin 3 *trace-indent-level*) (fx- i 1)))
	((fx<= i 0))
      (write-char #\space port) )
    (fprintf port "[~a] " *trace-indent-level*) ) )

(define (traced-procedure-entry name args)
  (let ((port (trace-output-port)))
    (trace-indent)
    (set! *trace-indent-level* (fx+ 1 *trace-indent-level*))
    (write (cons name args) port)
    (write ", Called from: " port)
    (write (conc (car (reverse (get-call-chain)))))
    (write-char #\newline port)
    (flush-output port) ) )

(define (traced-procedure-exit name results)
  (let ((port (trace-output-port)))
    (set! *trace-indent-level* (fx- *trace-indent-level* 1))
    (trace-indent)
    (fprintf port "~a -> " name)
    (if results
	(for-each
	 (lambda (x)
	   (write x port)
	   (write-char #\space port) )
	 results)
	(display "(escaping)" port))
    (write-char #\newline port)
    (flush-output port) ) )

(define (procedure-name proc)
  (cond ((procedure-information proc) =>
	 (lambda (info)
	   (if (pair? info) (car info) info) ) )
	(else '<unknown>)) )

(define (do-trace procs)
  (for-each
   (lambda (s)
     (ensure procedure? s)
     (cond ((traced? s)
	    (warning "procedure already traced" s) )
	   (else
	    (let ((name (procedure-name s)))
	      (when (trace-verbose)
		(fprintf (current-error-port) "; tracing ~a~%" name))
	      (set! *traced-procedures* (cons (cons s name) *traced-procedures*))
	      (advise 
	       'around s
	       (lambda (next args)
		 (let ((results #f))
		   (dynamic-wind
		       (cut traced-procedure-entry name args)
		       (lambda () 
			 (call-with-values (cut apply next args)
			   (lambda rs
			     (set! results rs)
			     (apply values rs))))
		       (cut traced-procedure-exit name results))))
	       '*trace*)))))
   procs) )

(define (do-untrace-all)
  (define (unadvise* p)
    (ignore-errors (unadvise p '*trace*)))
  (for-each
   (lambda (proc)
     (let ((proc (car proc)))
       (when (trace-verbose)
	 (fprintf (current-error-port) "; untracing ~a~%" (procedure-name proc))
	 (unadvise* proc))))
   *traced-procedures*)
  (set! *traced-procedures* '()))

(define (do-untrace procs)
  (for-each
   (lambda (s)
     (ensure procedure? s)
     (let ((p (assq s *traced-procedures*)) 
	   (name (procedure-name s)))
       (cond ((not p) (warning "procedure not traced" name))
	     (else
	      (when (trace-verbose)
		(fprintf (current-error-port) "; untracing ~a~%" name))
	      (ignore-errors (unadvise s '*trace*))
	      (set! *traced-procedures* 
		(delete 
		 p *traced-procedures* 
		 eq?))))))
   procs) )

(define (do-break procs)
  (for-each
   (lambda (s)
     (let ((name (procedure-name s)))
       (ensure procedure? s)
       (cond ((assq s *broken-procedures*)
	      (warning "procedure already has break-point" name))
	     (else
	      (when (trace-verbose)
		(fprintf (current-error-port) "; setting break-point in ~a~%" name))
	      (set! *broken-procedures* (cons (cons s name) *broken-procedures*))
	      (advise 
	       'before s
	       (lambda (args)
		 (break-entry name args) )
	       '*break*) ) )))
   procs) )

(define (do-unbreak procs)
  (for-each
   (lambda (s)
     (ensure procedure? s)
     (let ((p (assq s *broken-procedures*)) 
	   (name (procedure-name s)))
       (cond ((not p) (warning "procedure has no breakpoint" name))
	     (else
	      (when (trace-verbose)
		(fprintf (current-error-port) "; removing break-point in ~a~%" name))
	      (ignore-errors (unadvise s '*break*))
	      (set! *broken-procedures* (delete p *broken-procedures* eq?) ) ) ) ) )
   procs) )

(define (do-unbreak-all)
  (for-each
   (lambda (bp)
     (ignore-errors (unadvise (car bp) '*break*)))
   *broken-procedures*)
  (set! *broken-procedures* '())
  (void))

(define (trace . procs)
  (cond ((null? procs)
	 (when (pair? *traced-procedures*)
	   (printf "Traced:~%~%")
	   (for-each (lambda (p) (printf "  ~a~%" (cdr p))) *traced-procedures*)) )
	(else
	 (do-trace procs) ) ) )

(define (untrace . procs)
  (cond ((null? procs) (do-untrace-all))
	(else (do-untrace procs)))
  (void))

(define (break . procs)
  (cond ((null? procs)
	 (when (pair? *broken-procedures*)
	   (printf "Breakpoints:~%~%")
	   (for-each (lambda (p) (printf "  ~a~%" (cdr p))) *broken-procedures*)) )
	(else
	 (do-break procs) ) ) )

(define (unbreak . procs)
  (cond ((null? procs) (do-unbreak-all))
	(else (do-unbreak procs))))

(define (continue #!optional (bp *last-breakpoint*))
  (cond (*last-breakpoint*
	 (let ((exn *last-breakpoint*))
	   (set! *last-breakpoint* #f)
	   (break-resume exn) ) )
	(else (display "no breakpoint pending\n") ) ) )

(define c continue)

(define (traced? proc)
  (assq proc *traced-procedures*))

(define (trace/untrace . procs)
  (for-each
   (lambda (proc)
     ((if (traced? proc) do-untrace do-trace) (list proc)))
   procs))

(define (walk-module mname proc)
  (let* ((m (##sys#find-module mname))
	 (exps (nth-value 1 (##sys#module-exports m))))
    (for-each
     (lambda (exp)
       (let* ((realname (cdr exp))
	      (prim (get realname '##core#primitive)))
	 (if prim
	     (warning "export is a core-library primitive - not traced" (car exp))
	     (when (##sys#symbol-has-toplevel-binding? realname)
	       (let ((val (##sys#slot realname 0)))
		 (when (procedure? val)
		   (proc val)))))))
     exps)))

(define (trace-module . mnames)
  (for-each
   (lambda (mname)
     (walk-module mname trace))
   mnames))

(define (untrace-module . mnames)
  (for-each
   (lambda (mname)
     (walk-module 
      mname 
      (lambda (proc)
	(when (traced? proc)
	  (do-untrace (list proc))))))
   mnames))

)

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

Deleted utils/trace/trace.setup version [d222d610b4]. 

1
2
3
4
5
6
7
8
9

;;;; trace.setup -*- Scheme -*-


(compile -s trace.scm -O3 -d1 -j trace)
(compile -s trace.import.scm -O3 -d0)

(install-extension
 'trace
 '("trace.so" "trace.import.so"))

<
<
<
<
<
<
<
<
<

Modified utils/triage.rb from [1b394ae2b3] to [97159de683]. 

1
2















3
4
5
6
7
8
9

#!/usr/bin/env ruby
















#dir = "."
#if ARGV.length == 1
#  dir = ARGV[0]
#end
#puts dir
#exit 1



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/usr/bin/env ruby

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

#dir = "."
#if ARGV.length == 1
#  dir = ARGV[0]
#end
#puts dir
#exit 1

Modified utils/unlock_db.sh from [c92810209b] to [0c601fe6b4]. 

1
2















3
4
5
6
7
8
9

#!/bin/bash
















## Enh :
# 1. if /tmp/repo exists, delte it or name it something else
# 2. compare the repo is successfully created

## Usage :
# unlock_db.sh <database-name/complete path>



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

## Enh :
# 1. if /tmp/repo exists, delte it or name it something else
# 2. compare the repo is successfully created

## Usage :
# unlock_db.sh <database-name/complete path>

Modified utils/viewscreen from [df19e653be] to [6536ae359b]. 

1
2















3
4
5
6
7
8
9

#!/bin/bash
















if ! type screen &> /dev/null;then
  xterm -geometry 180x20 -e "$*;echo Press any key to continue;bash -c 'read -n 1 -s'" &
  exit
fi

if [[ $(screen -list | egrep 'Attached|Detached'|awk '{print $1}') == "" ]];then
    # echo "No screen found for displaying to. Run \"screen\" in an xterm"


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

#!/bin/bash

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

if ! type screen &> /dev/null;then
  xterm -geometry 180x20 -e "$*;echo Press any key to continue;bash -c 'read -n 1 -s'" &
  exit
fi

if [[ $(screen -list | egrep 'Attached|Detached'|awk '{print $1}') == "" ]];then
    # echo "No screen found for displaying to. Run \"screen\" in an xterm"

Modified utils/watch-close-wait.sh from [76c32422d7] to [f30a310ea5]. 















1
2
3
4
5
6
7















psline=$(ps -F -u $USER | grep "mtest" |grep " -run " | egrep " -(target|reqtarg) "| head -1)
id=$(echo $psline|awk '{print $2}')
echo "Watching process for command line: $psline"
echo "  with PID=$id"
while true;do
  echo "CLOSE_WAIT: $(lsof -n | grep CLOSE_WAIT | grep $id | wc -l) ALL OPEN: $(lsof -n |grep $id|wc -l) ALL CLOSE_WAIT: $(netstat -ap 2> /dev/null| grep -i close_wait| wc -l)"
  sleep 1

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

# This file is part of Megatest.
# 
#     Megatest is free software: you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation, either version 3 of the License, or
#     (at your option) any later version.
# 
#     Megatest is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

psline=$(ps -F -u $USER | grep "mtest" |grep " -run " | egrep " -(target|reqtarg) "| head -1)
id=$(echo $psline|awk '{print $2}')
echo "Watching process for command line: $psline"
echo "  with PID=$id"
while true;do
  echo "CLOSE_WAIT: $(lsof -n | grep CLOSE_WAIT | grep $id | wc -l) ALL OPEN: $(lsof -n |grep $id|wc -l) ALL CLOSE_WAIT: $(netstat -ap 2> /dev/null| grep -i close_wait| wc -l)"
  sleep 1

Deleted utils/wip/mtest-dbstop.scm version [f84335871c]. 

1
2
3
4
5
6
7
8
9
10
11
12

#!/p/foundry/env/pkgs/chicken/4.10.0_ext/bin/csi -s

(use chicken)
(use data-structures)


(include "/nfs/site/home/bjbarcla/bin2/mtest-repair-lib.scm")
(glib-color-mode 1)

(set! *this-cmd* "/nfs/site/home/bjbarcla/bin2/mtest-dbstop.scm")
(kill-in-db)
  

<
<
<
<
<
<
<
<
<
<
<
<

Deleted utils/wip/mtest-diag.scm version [7f6edef793]. 

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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165

#!/p/foundry/env/pkgs/chicken/4.10.0_ext/bin/csi -s

(use chicken)
(use data-structures)


(include "/nfs/site/home/bjbarcla/bin2/mtest-repair-lib.scm")
(glib-color-mode 1)

;;; check mtver in xterm
(let ((mt-ver (do-or-die "megatest -version")))
  (when (member mt-ver '("1.6309-738c" "1.6029"))
      (iwarn "This xterm has an older version of megatest.")
      (ierr "Please load latest megatest version to proceed.")
      (print "eg.: source ../scripts/newrel-setup.csh 1.63/11b")
      (exit 3)))


;;;; kill netbatch jobs from this megatest
;; TODO!


(define *diag* #t)
;;(define *user* (get-environment-variable "USER"))
(define *user* (do-or-die "ls -ld . | awk '{print $3}'"))
(print "user="*user*)
;;;; delete .homehost .homehost.config
;;;; if not on homehost, ssh homehost, cd here, killall mtest dboard
(if (not *diag*)
    (when (file-exists? ".homehost.config")
      (delete-db ".homehost.config")))
    
(when (file-exists? ".homehost")
  (let* ((homehost (with-input-from-file ".homehost" (lambda () (read)))))
    (let* ((homehostname (do-or-die "host `cat .homehost` | sed 's/.$//' | awk '{print $NF}' | awk -F. '{print $1}'"))
           (thishostname (get-environment-variable "HOST")))
      (when (not (equal? homehostname thishostname))
        (let* ((this-exe-compiled (car (argv)))
               (this-exe "/nfs/site/home/bjbarcla/bin2/mtest-diag.scm")
               (cmd (conc "ssh "homehostname" 'cd "(get-environment-variable "PWD")" && "this-exe"'")))
          (iwarn "Running on the homehost -- "homehostname)
          ;;(iwarn "eg: % ssh "homehostname" 'cd "(get-environment-variable "PWD")" && "(car (argv))"'")
          (print "cmd="cmd)
          ;;(inote "sleeping for 5 seconds.  hit ctrl-c now to run on homehost or wait to proceed.")
          (system cmd)
          (exit 0))))))




;;;; kill megatests and dashboards in this area
(define (kill-mtest-dboard)
  (if *diag*
      #f
      (let* ((this-toppath (pid->cwd (current-process-id)))
             (tmppath      (toppath->tmppath this-toppath))
             (config       (let ((res (conc this-toppath "/megatest.config")))
                             (when (not (file-exists? res))
                               (ierr "This is not a megatest run area; "res" does not exist.  Aborting.")
                               (exit 2))
                             res))
             (mtest-procs (get-my-mtest-procs))
             (dashboard-procs (get-my-dashboard-procs))
             (all-pids (map proc-PID (append mtest-procs dashboard-procs)))
             (our-pids (filter (lambda (pid)
                                 (equal? (pid->cwd pid) this-toppath))
                               all-pids)))

        (if (null? our-pids)
            (inote "No mtest or dboard processes on this host in in this runarea.")
            (begin
              (iwarn "Killing all megatest and dashboard processes on this host.")
              (gracefully-kill-pids our-pids)))
        )))

(kill-mtest-dboard)


;;;; delete /tmp/.$USER-portlogger.db
(let ((plfile (conc "/tmp/."*user* "-portlogger.db")))

  (if (safe-file-exists? plfile)
    (if *diag*
        (print "plfile exists - "plfile)
        (begin
          (inote "removing portlogger file")
          (system (conc "rm "plfile))))))


;;;; move logs dir aside
(when (not *diag*)
  (system (conc "mv logs logs-aside-`date +%s`"))
  (system "mkdir logs"))
  

;;;; fixes for dependency diagram
(when (not *diag*)
  (inote "Removing dep graph tmp files if they exist")
  (system (conc "rm /tmp/."*user*"-*.dot"))

  ;;#ln -s /p/fdk/gwa/$USER/fossil/ext/<your flow>_ext ext
  (let* ((toppath (pid->cwd (current-process-id)))
         (flow (car (string-split
                     (car (reverse (string-split toppath "/")))
                     ".")))
         (extdir (conc "/p/fdk/gwa/"*user*
                       "/fossil/ext/"flow"_ext")))
    (when (and (safe-file-exists? extdir)
               (not (safe-file-exists? "ext")))
      (inote "Linking in ext dir")
      (system (conc "ln -s "extdir" ext")))))
  

;;;; check for 0 byte megatest{,_ref}.db in tmp.  delete them
;;;; check for wal-mode megatest{,_ref}.db in tmp.  delete them
(define (repair-dbs)
  (let* ((this-toppath (pid->cwd (current-process-id)))
         (tmppath      (toppath->tmppath this-toppath))
         (golden-mtest-file (conc this-toppath "/megatest.db"))
         (golden-mtest-file-ok (check-db "megatest.db"))
         (tmp-mtest-file    (conc tmppath "/megatest.db"))
         (tmp-mtestref-file    (conc tmppath "/megatest_ref.db"))
         (tmp-mtest-file-ok (check-db tmp-mtest-file))
         (tmp-mtestref-file-ok (check-db tmp-mtestref-file))
         )
;;;; check for megatest{,_ref}.db in tmp that die on .schema.  delete them
    (when (safe-file-exists? tmppath)
        (if tmp-mtest-file-ok
            (inote "tmp megatest db file ok")
            (if *diag*
                (print "diag: tmp megatest db broken - "tmp-mtest-file)
                (delete-db tmp-mtest-file)))
        (if tmp-mtestref-file-ok
            (inote "tmp megatestref db file ok")
            (if *diag*
                (print "diag: tmpref megatest db broken - "tmp-mtestref-file)
                (delete-db tmp-mtestref-file))))

;;;; check for megatest.db
    (if golden-mtest-file-ok
        (inote "golden megatest db file ok")
        (if (not (file-exists? golden-mtest-file))
            (inote "megatest.db not present.  Continuing.")
            (begin
          ;;;; if golden megatest db is broken, stop now!
              (ierr "Golden megatest.db is broken.  Please delete it or replace it from a backup version in .snapshot.  If critical, contact env team to assist.")
              (sendmail "bjbarcla" "!!Bad golden megatest.db" this-toppath)
              (inote "Backups in .snapshot:")
              (system "ls -l .snapshot/*/megatest.db")
              (ierr "Not proceeding with any more checks.")
              (exit 3))))



    ))

(repair-dbs)
    








<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

Deleted utils/wip/mtest-nbstop.scm version [7b4c78c86f]. 

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

#!/p/foundry/env/pkgs/chicken/4.10.0_ext/bin/csi -s

(use chicken)
(use data-structures)


(include "/nfs/site/home/bjbarcla/bin2/mtest-repair-lib.scm")
(glib-color-mode 1)

(set! *this-cmd* "/nfs/site/home/bjbarcla/bin2/mtest-nbstop.scm")

(inote "Killing local mtest/dboard in this run area.")
(kill-mtest-dboard)

;;;; move logs dir aside
(inote "move logs")
(system (conc "mv logs logs-aside-`date +%s`"))
(system "mkdir logs")



(inote "Killing netbatch mtest jobs launched from this run area.")
(let ((jobcount (kill-mtest-jobs-in-netbatch)))
  (when (> jobcount 0)
    (inote "Marking in-flight tests killed in db")
    (when (db-islocked? "megatest.db")
      (iwarn "Unlocking megatest.db")
      (db-unlock "megaetest.db"))
    (kill-in-db)))

(inote "Final reaping of mtest/dboard")
(kill-mtest-dboard)



<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

Deleted utils/wip/mtest-reaper.scm version [b3b10d5f69]. 

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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142

#!/p/foundry/env/pkgs/chicken/4.10.0_ext/bin/csi -s

(use general-lib)
(use typed-records)
(use regex-literals)
(use regex)
(use sql-de-lite)

(defstruct proc
    (USER "")
  (PID -1)
  (%CPU -1.0)
  (%MEM -1.0)
  (VSZ -1)
  (RSS -1)
  (TTY "")
  (STAT "")
  (START "")
  (TIME "")
  (COMMAND ""))

(define (linux-get-process-info-records)
  (let* ((raw (do-or-die "/bin/ps auwx"))
         (all-lines (string-split raw "\n"))
         (lines (cdr all-lines)) ;; skip title lines
         (re #/^(\S+)\s+(\d+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*)$/))
    (filter
     proc?
     (map
      (lambda (line)
        (let ((match (string-match re line)))
          (if match
              (make-proc
               USER:    (list-ref match 1)
               PID:     (string->number (list-ref match 2))
               %CPU:    (string->number (list-ref match 3))
               %MEM:    (string->number (list-ref match 4))
               VSZ:     (string->number (list-ref match 5))
               RSS:     (string->number (list-ref match 6))
               TTY:     (string->number (list-ref match 7))
               STAT:    (list-ref match 8)
               START:   (list-ref match 9)
               TIME:    (list-ref match 10)
               COMMAND: (list-ref match 11))
              #f)))
      lines))))
        
(define (get-my-mtest-server-procs)
  (let* ((procs (linux-get-process-info-records))
        (my-mtest-procs
         (filter
          (lambda (a-proc)
            (and
             (equal? (get-environment-variable "USER") (proc-USER a-proc))
             (string-match #/^.*\/mtest\s+.*-server.*/ (proc-COMMAND a-proc))))
          procs)))
    my-mtest-procs))


(define (pid->environ-hash pid)
  (let* ((envfile (conc "/proc/"pid"/environ"))
         (ht (make-hash-table))
         (rawdata (with-input-from-file envfile read-string))
         (lines (string-split rawdata  (make-string 1 #\nul ))))
    (for-each
     (lambda (line)
       (let ((match (string-match #/(^[^=]+)=(.*)/ line)))
         (if match
             (hash-table-set! ht (list-ref match 1) (list-ref match 2)))))
     lines)
    ht))

(define (pid->cwd pid)
  (read-symbolic-link (conc "/proc/"pid"/cwd")))

(define (pid->mtest-monitor-db-file pid)
  (let* ((env   (pid->environ-hash pid))
         (ltdir (hash-table-ref/default env "MT_LINKTREE" #f))
         (radir (hash-table-ref/default env "MT_RUN_AREA_HOME" #f))
         (cwd   (pid->cwd pid)))
    (let ((res
           (cond
            (ltdir (conc ltdir "/.db/monitor.db"))
            (radir (conc
                    (do-or-die
                     (conc "megatest -start-dir "radir" -show-config -section setup -var linktree"))
                    "/.db/monitor.db"))
            (cwd  (conc
                   (do-or-die
                    (conc "megatest -start-dir "cwd" -show-config -section setup -var linktree"))
                   "/.db/monitor.db"))
            
            (else #f))))
      res)))
      




(define (get-mdb-status mdb-file pid)
    ;; select state from servers where pid='4465';
  
  (cond
   ((not (string? mdb-file)) (conc "mdb-file could not be determined for pid " pid ">>"mdb-file ))
   ((not (file-exists? mdb-file)) (conc "mdb-file does not exist for pid "pid" : "mdb-file))
   (else
    (let ((dbh (open-database mdb-file)))
      
      (set-busy-handler! dbh 10000)
      (let* ((sql-str "select state from servers where pid=?;")
             (stm (sql dbh sql-str))
             (alists (query fetch-alists stm (->string pid))))
        (if (null? alists)
            "server pid not in monitor.db"
            (cdr (car (car alists)))))))))

    
(define (mtest-server-pid->status pid)
  (let* ((mdb-file (pid->mtest-monitor-db-file pid)))
    (if mdb-file
        (get-mdb-status mdb-file pid)
        "no monitor.db file could be found"
        )))


(define (kill pid)
  (print "KILL "pid)
  (do-or-die (conc "kill -9 "pid)))

(define (reap-defunct-mtest-server-pid pid)
  (let ((status (mtest-server-pid->status pid)))
    (print pid"->"(mtest-server-pid->status pid))
    (if (member status (list "running" "dbprep" "available" "collision"))
        (print "pid="pid" in status "status" -- not killing")
        (kill pid))))
        
(let* ((procs (get-my-mtest-server-procs))
       (pids (map proc-PID procs))
       )
  
  (for-each reap-defunct-mtest-server-pid pids))


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

Deleted utils/wip/mtest-repair-lib.scm version [c317aec679]. 

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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508

(use general-lib)
(use typed-records)
(use regex-literals)
(use regex)
(use sql-de-lite)
(use posix)
(use files)
(use s11n)
(use ports)
(use z3)
(use base64)
(use matchable)




(define (cli-arg arg #!key (default #f) (is-list #f))
  (let* ((temp    (skim-cmdline-opts-withargs-by-regex arg)))
      (if (> (length temp) 0)
          (if is-list
              temp
              (car temp))
          default)))

(define (cli-switch arg)
  (let ((temp (skim-cmdline-opts-noarg-by-regex arg)))
    (if (> (length temp) 0)
        (car temp)
        #f)))


         
(defstruct nbjob
    pool
    jobid
    owner
    mtver
    user
    status
    cmdline
    execute)

(define (cmdline->execute cmdline)
  (let* ((match (string-match ".*-execute\\s+(\\S+)" cmdline)))
    (if match
        (with-input-from-string (z3:decode-buffer (base64-decode (cadr match))) read)
        #f)))


(define (nbjob-execute-ref nbjob key #!key (default #f))
  (let ((execute (nbjob-execute nbjob)))
    (if (list? execute)
        (let* ((match (alist-ref key execute)))
          (if match
              (if (list? match) (car match) match)
              default))
        default)))

(define (nbjob-process pool nbstatus-line)
  (let ((toks (string-split nbstatus-line ",")))
    (if (eq? 4 (length toks))
        (if (equal? (list-ref toks 1) "Jobid")
            #f
            (begin
              (let ((res
                     (make-nbjob
                      pool:    pool
                      status:  (list-ref toks 0)
                      jobid:   (list-ref toks 1)
                      user:    (list-ref toks 2)
                      cmdline: (list-ref toks 3)
                      execute: (cmdline->execute (list-ref toks 3))
                      )))
                res)))
        #f)))

(define (get-mtest-nb-jobs user nbpools #!key (cmdline-filter "megatest"))
  (let* ((res
          (apply append
                 (map (lambda (pool)
                        (let* (;;(user-filter ".*")
                               (user-filter user)
                               (cmd
                                (conc "nbstatus jobs --tar "pool" --fields status,jobid,user,cmdline --format csv "
                                      "'USER=~\""user-filter
                                      "\"&&cmdline=~\""cmdline-filter"\"'"))
                               (res (do-or-die cmd)))
                          (filter nbjob?
                                  (map (lambda (line)
                                         (nbjob-process pool line))
                                       (string-split res "\n")))))
                      nbpools))))
    res))

;;(define foo (get-mtest-nb-jobs "bjbarcla" '("pdx_normal" "pdx_critical")))

(define (cmdline->execute cmdline)
  (let* ((match (string-match ".*-execute\\s+(\\S+)" cmdline)))
    (if match
        (with-input-from-string (z3:decode-buffer (base64-decode (cadr match))) read)
        #f)))

;;;; kill jobs in netbatch for this area
(define (kill-mtest-jobs-in-netbatch)
  (let ((pwd (get-environment-variable "PWD"))
        (jobs (get-mtest-nb-jobs (get-environment-variable "USER") '("pdx_normal" "pdx_critical") )))

    (for-each
     (lambda (job)
       (let* ((jobid  (nbjob-jobid job))
              (pool   (nbjob-pool job))
              (status (nbjob-status job))
              (cmd (conc "nbjob --target "pool" remove "jobid)))
         ;;(print status)
         (print  cmd)
         (system cmd)))
                                        ;(pp (nbjob->alist job))
     (filter
      (lambda (job)
        (equal? (nbjob-execute-ref job 'toppath) pwd))
      jobs))
    (length jobs)

    ))


;;;; kill megatest jobs in running in netbatch
(define (kill-in-db #!key (megatest_exe "megatest"))
  (let* ((all-targ-patt (do-or-die "sqlite3 megatest.db \"select id from keys\" | tr \"\\n1234567890\" \"/%%%%%%%%%%\" | sed 's/\\/$//'"))
         )
    (for-each (lambda (state)
                (let* ((cmd (conc megatest_exe " -state "state" -set-state-status KILLED,n/a -testpatt % -target "all-targ-patt" -runname %")))
                  (print cmd)
                  (system cmd)))
              '("REMOTEHOSTSTART" "LAUNCHED" "RUNNING" "KEEP_TRYING" "PREQ_FAIL"))))



;;;; kill megatests and dashboards in this area running on this host
(define (kill-mtest-dboard)
  
  (let* ((this-toppath (pid->cwd (current-process-id)))
         (tmppath      (toppath->tmppath this-toppath))
         (config       (let ((res (conc this-toppath "/megatest.config")))
                         (when (not (file-exists? res))
                           (ierr "This is not a megatest run area; "res" does not exist.  Aborting.")
                           (exit 2))
                         res))
         (mtest-procs (get-my-mtest-procs))
         (dashboard-procs (get-my-dashboard-procs))
         (all-pids (map proc-PID (append mtest-procs dashboard-procs)))
         (our-pids (filter (lambda (pid)
                             ;;(print (pid-COMMAND pid))
                             (and
                              (equal? (pid->cwd pid) this-toppath)
                              
                              ))
                           all-pids)))

    (if (null? our-pids)
        (inote "No mtest or dboard processes on this host in in this runarea.")
        (begin
          (iwarn "Killing all megatest and dashboard processes on this host.")
          (gracefully-kill-pids our-pids)))
    ))



(define (db-mt-version dbpath)
  (let* ((cmd (conc "sqlite3 "dbpath" 'select val from metadat where var=\"MEGATEST_VERSION\"'"))
         (res (do-or-die cmd)))
    res))
   
;; TODO
(define (db-islocked? dbpath)
  (let-values (((ec so se) (isys (conc "sqlite3 "dbpath" vacuum"))))
    (let* ((message se)
           (is-locked (string-match "^.*database is locked.*$" message)))
      (inote "dbfile - "dbpath "; message - "message)
      is-locked)))

(define (db-unlock dbpath)
  (system (conc "/nfs/site/bjbarcla/bin/unlock_db.sh " dbpath))

  ;; (let* ((temp-dbpath (conc "/tmp/"(get-environment-variable "USER")"-"(current-process-id)".db")))
  ;;   (inote "Unlocking "dbpath)
  ;;   (do-or-die (conc "cp "dbpath" "temp-dbpath))
  ;;   (do-or-die (conc "rm -f "dbpath))
  ;;   (let* ((cmd (conc "sqlite3 "temp-dbpath" .dump | sqlite3 "dbpath)))
  ;;     (inote "Running: "cmd)
  ;;     (system cmd))
  ;;   ;;(do-or-die "sqlite3 "temp-dbpath" .dump | sqlite3 "dbpath)
  ;;   (if (db-islocked? dbpath)
  ;;       (begin
  ;;         (ierr "Could not unlock "dbpath)
  ;;         (exit 5))
  ;;       (inote "Unlocked "dbpath))
  ;;   #t)

  )


(define *user* (do-or-die "ls -ld . | awk '{print $3}'"))

(define (false-on-exception thunk)
  (handle-exceptions exn #f (thunk) ))

(define (safe-file-exists? path-string)
  (false-on-exception (lambda () (file-exists? path-string))))

(defstruct proc
    (USER "")
  (PID -1)
  (%CPU -1.0)
  (%MEM -1.0)
  (VSZ -1)
  (RSS -1)
  (TTY "")
  (STAT "")
  (START "")
  (TIME "")
  (COMMAND ""))

(define (toppath->tmppath toppath)
  (let* ((user *user*)
         (area (car (string-split
                     (car (reverse (string-split toppath "/")))
                     ".")))
         (dotified-path (string-substitute "/" "." toppath "all")))
    (conc "/tmp/" user "/megatest_localdb/" area "/" dotified-path)))


(define (delete-db dbfile)
  (let* ((db-files (glob (conc dbfile "*"))))
    (for-each
     (lambda (file)
       (inote "delete file " file)
       (if (delete-file* file)
           (inote "Removed file - " file)
           (iwarn "Could Not Remove file - " file))
       )
     db-files)))

(define (check-db dbfile)
  (let* ((has-wal (safe-file-exists? (conc dbfile "-wal")))
         (has-shm (safe-file-exists? (conc dbfile "-shm")))
         (has-journal (safe-file-exists? (conc dbfile "-journal")))
         (has-db (safe-file-exists? dbfile))
         (ok-flag #t))
    (when has-journal
      (iwarn "Journal exists - "(conc dbfile "-journal"))
      )
    (when has-wal
      (set! ok-flag #f)
      (iwarn "Wal-mode db exists: "(conc dbfile "-wal")))
    (if (not has-db)
        (begin
          (inote "db does not exists " dbfile)
          (set! ok-flag #f))
        (let* ((db-size (file-size dbfile)))
          (inote "db size = " db-size " -- " dbfile)
          (when (member db-size (list 0 1024))
            (iwarn "db has bad size - "db-size" -- "dbfile)
            (set! ok-flag #f))))
    ok-flag))
               

(define (linux-get-process-info-records)
  (let* ((raw (do-or-die "/bin/ps auwx"))
         (all-lines (string-split raw "\n"))
         (lines (cdr all-lines)) ;; skip title lines
         (re (regexp "^(\\S+)\\s+(\\d+)\\s+(\\S+)\\s+(\\S+)\\s+(\\S+)\\s+(\\S+)\\s+(\\S+)\\s+(\\S+)\\s+(\\S+)\\s+(\\S+)\\s+(.*)$")))
    (filter
     proc?
     (map
      (lambda (line)
        (let ((match (string-match re line)))
          (if match
              (make-proc
               USER:    (list-ref match 1)
               PID:     (string->number (list-ref match 2))
               %CPU:    (string->number (list-ref match 3))
               %MEM:    (string->number (list-ref match 4))
               VSZ:     (string->number (list-ref match 5))
               RSS:     (string->number (list-ref match 6))
               TTY:     (string->number (list-ref match 7))
               STAT:    (list-ref match 8)
               START:   (list-ref match 9)
               TIME:    (list-ref match 10)
               COMMAND: (list-ref match 11))
              #f)))
      lines))))
        
(define (get-my-mtest-server-procs)
  (let* ((procs (linux-get-process-info-records))
        (my-mtest-procs
         (filter
          (lambda (a-proc)
            (and
             (equal? *user* (proc-USER a-proc))
             (string-match "^.*/mtest\\s+.*-server.*" (proc-COMMAND a-proc))))
          procs)))
    my-mtest-procs))

(define (get-my-mtest-procs)
  (let* ((procs (linux-get-process-info-records))
        (my-mtest-procs
         (filter
          (lambda (a-proc)
            (and
             (equal? *user* (proc-USER a-proc))
             (string-match "^.*/m(ega)?test .*" (proc-COMMAND a-proc))
             (not (string-match "^.*/mtest-repair.*" (proc-COMMAND a-proc)))))
          procs)))
    my-mtest-procs))

(define (get-my-dashboard-procs)
  (let* ((procs (linux-get-process-info-records))
        (my-dboard-procs
         (filter
          (lambda (a-proc)
            (and
             (equal? *user* (proc-USER a-proc))
             (string-match "^.*/dboard.*" (proc-COMMAND a-proc))))
          procs)))
    my-dboard-procs))


(define (pid->environ-hash pid)
  (let* ((envfile (conc "/proc/"pid"/environ"))
         (ht (make-hash-table))
         (rawdata (with-input-from-file envfile read-string))
         (lines (string-split rawdata  (make-string 1 #\nul ))))
    (for-each
     (lambda (line)
       (let ((match (string-match "(^[^=]+)=(.*)" line)))
         (if match
             (hash-table-set! ht (list-ref match 1) (list-ref match 2)))))
     lines)
    ht))

(define (pid->cwd pid)
  (read-symbolic-link (conc "/proc/"pid"/cwd")))

(define (pid->mtest-monitor-db-file pid #!key (megatest_exe "megatest"))
  (let* ((env   (pid->environ-hash pid))
         (ltdir (hash-table-ref/default env "MT_LINKTREE" #f))
         (radir (hash-table-ref/default env "MT_RUN_AREA_HOME" #f))
         (cwd   (pid->cwd pid)))
    (let ((res
           (cond
            (ltdir (conc ltdir "/.db/monitor.db"))
            (radir (conc
                    (do-or-die
                     (conc megatest_exe " -start-dir "radir" -show-config -section setup -var linktree"))
                    "/.db/monitor.db"))
            (cwd  (conc
                   (do-or-die
                    (conc megatest_exe " -start-dir "cwd" -show-config -section setup -var linktree"))
                   "/.db/monitor.db"))
            
            (else #f))))
      res)))
      




(define (get-mdb-status mdb-file pid)
    ;; select state from servers where pid='4465';
  
  (cond
   ((not (string? mdb-file)) (conc "mdb-file could not be determined for pid " pid ">>"mdb-file ))
   ((not (safe-file-exists? mdb-file)) (conc "mdb-file does not exist for pid "pid" : "mdb-file))
   (else
    (let ((dbh (open-database mdb-file)))
      
      (set-busy-handler! dbh 10000)
      (let* ((sql-str "select state from servers where pid=?;")
             (stm (sql dbh sql-str))
             (alists (query fetch-alists stm (->string pid))))
        (if (null? alists)
            "server pid not in monitor.db"
            (cdr (car (car alists)))))))))

    
(define (mtest-server-pid->status pid)
  (let* ((mdb-file (pid->mtest-monitor-db-file pid)))
    (if mdb-file
        (get-mdb-status mdb-file pid)
        "no monitor.db file could be found"
        )))


(define (gracefully-kill-pids pids)
  (for-each (lambda (pid)
              (print "kill "pid)
              (system (conc "kill "pid)))
            pids)
  (sleep 5)
  (let* ((procs-left (linux-get-process-info-records))
         (pids-left (map proc-PID procs-left)))
    (for-each (lambda (pid)
                (when (member pid pids-left)
                  (print "kill -9"pid)
                  (system (conc "kill -9 "pid))))
              pids)))
  
            
              
(define (kill pid)
  (print "KILL "pid)
  (do-or-die (conc "kill -9 "pid)))

(define (reap-defunct-mtest-server-pid pid)
  (let ((status (mtest-server-pid->status pid)))
    (print pid"->"(mtest-server-pid->status pid))
    (if (member status (list "running" "dbprep" "available" "collision"))
        (print "pid="pid" in status "status" -- not killing")
        (kill pid))))
        
;; (let* ((procs (get-my-mtest-server-procs))
;;        (pids (map proc-PID procs))
;;        )
  
;;   (for-each reap-defunct-mtest-server-pid pids))



(define (mtdbver->mtrelver mtdbver)
  (let* ((table-alist '(
                        ("1.5402" . "1.54/02")
                        ("1.5406" . "1.54/05")
                        ("1.5408" . "1.54/07")
                        ("1.5409" . "1.54/09")
                        ("1.5412" . "1.54/12")
                        ("1.5413" . "1.54/13")
                        ("1.5414" . "1.54/14")
                        ("1.5415" . "1.54/15")
                        ("1.5416" . "1.54/16")
                        ("1.5417" . "1.54/17")
                        ("1.5418" . "1.54/18")
                        ("1.5419" . "1.54/19")
                        ("1.5421" . "1.54/21")
                        ("1.5411" . "1.54/support-for-skip")
                        ("1.5522" . "1.55/22")
                        ("1.5523" . "1.55/23")
                        ("1.5524" . "1.55/24")
                        ("1.5525" . "1.55/25")
                        ("1.6001" . "1.60/01")
                        ("1.6002" . "1.60/02")
                        ("1.6003" . "1.60/03")
                        ("1.6004" . "1.60/04")
                        ("1.6005" . "1.60/05")
                        ("1.6006" . "1.60/06")
                        ("1.6007" . "1.60/07")
                        ("1.6008" . "1.60/08")
                        ("1.6009" . "1.60/09")
                        ("1.6009" . "1.60/11")
                        ("1.6012" . "1.60/12")
                        ("1.6013" . "1.60/13")
                        ("1.6014" . "1.60/14")
                        ("1.6015" . "1.60/15")
                        ("1.6016" . "1.60/16")
                        ("1.6017" . "1.60/17")
                        ("1.6018" . "1.60/18")
                        ("1.6019" . "1.60/19")
                        ("1.6021" . "1.60/21")
                        ("1.6022" . "1.60/22")
                        ("1.6023" . "1.60/23")
                        ("1.6024" . "1.60/24")
                        ("1.6025" . "1.60/25")
                        ("1.6026" . "1.60/26")
                        ("1.6027" . "1.60/27")
                        ("1.6028" . "1.60/28")
                        ;;("1.6029" . "1.60/29")
                        ("1.6029" . "1.60/29a")
                        ("1.6031" . "1.60/31")
                        ("1.6101" . "1.61/01")
                        ("1.6101" . "1.61/01a")
                        ("1.6102-c2ba" . "1.61/02")
                        ("1.6103-3e88" . "1.61/03")
                        ("1.6104-ee53" . "1.61/04")
                        ("1.6105-232b" . "1.61/05")
                        ("1.6201-e652" . "1.62/01")
                        ("1.6204-c74d" . "1.62/04")
                        ("1.6205-aff0" . "1.62/05")
                        ("1.6207-6f59" . "1.62/07")
                        ("1.6301-fbf0" . "1.63/01")
                        ("1.6302-da4a" . "1.63/02")
                        ("1.6303-aa5f" . "1.63/03")
                        ("1.6304-fa49" . "1.63/04")
                        ("1.6305-a03b" . "1.63/05")
                        ("1.6306-7a12" . "1.63/06")
                        ("1.6307-fb5d" . "1.63/07")
                        ("1.6308-35e0" . "1.63/08")
                        ("1.6309-738c" . "1.63/09")
                        ("1.6309-880c" . "1.63/09a")
                        ("1.6309-b566" . "1.63/09b")
                        ("1.6311-fb43" . "1.63/11")
                        ("1.6311-fb43" . "1.63/11b")
                        ("1.6311-8a6c" . "1.63/11b")
                        ("1.6402-03c5" . "1.64/02")
                        )
                      )
         (res (alist-ref mtdbver table-alist equal?)))
    res))


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

Deleted utils/wip/mtest-repair.scm version [abac938a88]. 

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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139

#!/p/foundry/env/pkgs/chicken/4.10.0_ext/bin/csi -s

(use chicken)
(use data-structures)


(include "/nfs/site/home/bjbarcla/bin2/mtest-repair-lib.scm")
(glib-color-mode 1)

;;(define this-cmd (car (argv)))
(define this-cmd "/nfs/site/home/bjbarcla/bin2/mtest-repair.scm")

;;; check mtver in xterm

;; note - 11b is 1.6311-fb43
(let ((mt-ver (do-or-die "megatest -version")))
  (when (member mt-ver '("1.6309-738c" "1.6029" "1.6309-b566"))
      (iwarn "This xterm has an older version of megatest.")
      (ierr "Please load latest megatest version to proceed.")
      (print "eg.: source ../scripts/newrel-setup.csh 1.63/11b")
      (exit 3)))


;;;; kill netbatch jobs from this megatest
;;(kill-mtest-dboard)
;;(system "/nfs/site/home/bjbarcla/bin2/mtest-nbstop.scm")


;;;; delete .homehost .homehost.config
;;;; if not on homehost, ssh homehost, cd here, killall mtest dboard
(when (file-exists? ".homehost.config")
  (delete-db ".homehost.config"))

(when (file-exists? ".homehost")
  (let* ((homehost (with-input-from-file ".homehost" (lambda () (read)))))
    (let* ((homehostname (do-or-die "host `cat .homehost` | sed 's/.$//' | awk '{print $NF}' | awk -F. '{print $1}'"))
           (thishostname (get-environment-variable "HOST")))
      (when (not (equal? homehostname thishostname))
          (iwarn "Please also run this on the homehost -- "homehostname)

          (iwarn "eg: % ssh "homehostname" 'cd "(get-environment-variable "PWD")" && "this-cmd"'")
          (print "")
          (inote "sleeping for 5 seconds.  hit ctrl-c now to run on homehost or wait to proceed.")
          (sleep 5)))))





(kill-mtest-dboard)


;;;; delete /tmp/.$USER-portlogger.db
(let ((plfile (conc "/tmp/."(get-environment-variable "USER") "-portlogger.db")))
  (when (safe-file-exists? plfile)
    (inote "removing portlogger file")
    (system (conc "rm "plfile))))


;;;; move logs dir aside
(system (conc "mv logs logs-aside-`date +%s`"))
(system "mkdir logs")

;;;; fixes for dependency diagram
(inote "Removing dep graph tmp files if they exist")
(system (conc "rm /tmp/."(get-environment-variable "USER")"-*.dot"))

;;#ln -s /p/fdk/gwa/$USER/fossil/ext/<your flow>_ext ext
(let* ((toppath (pid->cwd (current-process-id)))
       (flow (car (string-split
                   (car (reverse (string-split toppath "/")))
                   ".")))
       (extdir (conc "/p/fdk/gwa/"(get-environment-variable "USER")
                     "/fossil/ext/"flow"_ext")))
  (when (and (safe-file-exists? extdir)
           (not (safe-file-exists? "ext")))
    (inote "Linking in ext dir")
    (system (conc "ln -s "extdir" ext"))))


;;;; check for 0 byte megatest{,_ref}.db in tmp.  delete them
;;;; check for wal-mode megatest{,_ref}.db in tmp.  delete them
(define (repair-dbs)
  (let* ((this-toppath (pid->cwd (current-process-id)))
         (tmppath      (toppath->tmppath this-toppath))
         (golden-mtest-file (conc this-toppath "/megatest.db"))
         (golden-mtest-file-ok (check-db "megatest.db"))
         (tmp-mtest-file    (conc tmppath "/megatest.db"))
         (tmp-mtestref-file    (conc tmppath "/megatest_ref.db"))
         (tmp-mtest-file-ok (check-db tmp-mtest-file))
         (tmp-mtestref-file-ok (check-db tmp-mtestref-file))
         (alldbs (list tmp-mtest-file tmp-mtestref-file golden-mtest-file))
         )
;;;; check for megatest{,_ref}.db in tmp that die on .schema.  delete them
    (when (safe-file-exists? tmppath)
        (if tmp-mtest-file-ok
            (inote "tmp megatest db file ok")
            (delete-db tmp-mtest-file))
        (if tmp-mtestref-file-ok
            (inote "tmp megatestref db file ok")
            (delete-db tmp-mtestref-file)))

    ;;;;; check for locked dbs
    (for-each (lambda (dbfile)
                (let* ((locked (db-islocked? dbfile)))
                  (if (db-islocked? dbfile)
                      (begin
                        (iwarn "db locked - "dbfile)
                        (db-unlock dbfile))
                      (inote "db not locked - "dbfile))))
              alldbs)
    
;;;; check for megatest.db
    (if golden-mtest-file-ok
        (inote "golden megatest db file ok")
        (if (not (file-exists? golden-mtest-file))
            (inote "megatest.db not present.  Continuing.")
            (begin
          ;;;; if golden megatest db is broken, stop now!
              (ierr "Golden megatest.db is broken.  Please delete it or replace it from a backup version in .snapshot.  If critical, contact env team to assist.")
              (sendmail "bjbarcla" "!!Bad golden megatest.db" this-toppath)
              (inote "Backups in .snapshot:")
              (system "ls -l .snapshot/*/megatest.db")
              (ierr "Not proceeding with any more checks.")
              (exit 3))))
    ))

;; TODO: check for and fix locked megatest.db and locked monitor.db (ritika working on)


(repair-dbs)
    








<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

Modified vg.scm from [2067ad836c] to [79994f610c]. 

1
2
3
4
5




6

7
8

9


10
11
12
13
14
15
16

;;
;; Copyright 2016  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.



;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use typed-records srfi-1)

(declare (unit vg))
(use canvas-draw iup)



|
|
>
>
>
>

>
|
|
>
|
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

;;
;; Copyright 2016  Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use typed-records srfi-1)

(declare (unit vg))
(use canvas-draw iup)

Modified widgets.scm from [3d56925ea9] to [2895969573]. 















1
2
3
4
5
6
7















(require-library srfi-4 iup)
(import srfi-4 iup iup-pplot iup-glcanvas) ;; iup-web

(define (popup dlg . args)
  (apply show dlg #:modal? 'yes args)
  (destroy! dlg))


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

(require-library srfi-4 iup)
(import srfi-4 iup iup-pplot iup-glcanvas) ;; iup-web

(define (popup dlg . args)
  (apply show dlg #:modal? 'yes args)
  (destroy! dlg))

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