diff options
Diffstat (limited to '')
-rw-r--r-- | code/modules/maintainers.scm | 68 |
1 files changed, 68 insertions, 0 deletions
diff --git a/code/modules/maintainers.scm b/code/modules/maintainers.scm new file mode 100644 index 0000000..a0ea81d --- /dev/null +++ b/code/modules/maintainers.scm | |||
@@ -0,0 +1,68 @@ | |||
1 | ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> | ||
2 | ;;; | ||
3 | ;;; This program is free software; you can redistribute it and/or modify it | ||
4 | ;;; under the terms of the GNU General Public License as published by | ||
5 | ;;; the Free Software Foundation; either version 3 of the License, or (at | ||
6 | ;;; your option) any later version. | ||
7 | ;;; | ||
8 | ;;; This program is distributed in the hope that it will be useful, but | ||
9 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | ||
10 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
11 | ;;; GNU General Public License for more details. | ||
12 | ;;; | ||
13 | ;;; You should have received a copy of the GNU General Public License | ||
14 | ;;; along with this program. If not, see <http://www.gnu.org/licenses/>. | ||
15 | |||
16 | (define-module (maintainers) | ||
17 | #:use-module (guix records) | ||
18 | #:use-module (ssh popen) | ||
19 | #:use-module ((ssh session) #:select (disconnect!)) | ||
20 | #:use-module (guix ssh) | ||
21 | #:use-module (srfi srfi-9) | ||
22 | #:export (maintainer? | ||
23 | maintainer-name | ||
24 | maintainer-address | ||
25 | maintainer-packages | ||
26 | |||
27 | maintainer-collective? | ||
28 | read-maintainers | ||
29 | read-maintainers-from-fencepost)) | ||
30 | |||
31 | (define-record-type <maintainer> | ||
32 | (maintainer name address packages) | ||
33 | maintainer? | ||
34 | (name maintainer-name) | ||
35 | (address maintainer-address) | ||
36 | (packages maintainer-packages)) | ||
37 | |||
38 | (define (maintainer-collective? maintainer) | ||
39 | (or (string-suffix? "maintainers@gnu.org" (maintainer-address maintainer)) | ||
40 | (string-suffix? " maintainers" (maintainer-name maintainer)) | ||
41 | (string-suffix? " committee" (maintainer-name maintainer)))) | ||
42 | |||
43 | (define (read-maintainers port) | ||
44 | "Read from PORT recutils-formatted info about GNU maintainers, and return a | ||
45 | list of <maintainer> records." | ||
46 | (define (read-one port) | ||
47 | (alist->record (recutils->alist port) | ||
48 | maintainer | ||
49 | '("name" "email" "package") | ||
50 | '("package"))) | ||
51 | |||
52 | (let loop ((result '())) | ||
53 | (if (eof-object? (peek-char port)) | ||
54 | (reverse result) | ||
55 | (let ((maintainer (read-one port))) | ||
56 | (loop (if (and (maintainer-name maintainer) | ||
57 | (maintainer-address maintainer)) | ||
58 | (cons maintainer result) | ||
59 | result)))))) | ||
60 | |||
61 | (define (read-maintainers-from-fencepost) | ||
62 | (let* ((session (open-ssh-session "fencepost.gnu.org")) | ||
63 | (pipe (open-remote-pipe* session OPEN_READ | ||
64 | "cat" "/gd/gnuorg/maintainers")) | ||
65 | (maintainers (read-maintainers pipe))) | ||
66 | (close-port pipe) | ||
67 | (disconnect! session) | ||
68 | maintainers)) | ||