Commit | Line | Data |
---|---|---|
79f9dee3 MO |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org> | |
3 | ;;; | |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (guix scripts discover) | |
20 | #:use-module (guix avahi) | |
21 | #:use-module (guix config) | |
22 | #:use-module (guix scripts) | |
23 | #:use-module (guix ui) | |
1f49ab6e | 24 | #:use-module (guix utils) |
79f9dee3 MO |
25 | #:use-module (guix build syscalls) |
26 | #:use-module (guix build utils) | |
27 | #:use-module (guix scripts publish) | |
28 | #:use-module (ice-9 rdelim) | |
29 | #:use-module (srfi srfi-37) | |
30 | #:export (read-substitute-urls | |
31 | ||
32 | guix-discover)) | |
33 | ||
34 | (define (show-help) | |
35 | (format #t (G_ "Usage: guix discover [OPTION]... | |
36 | Discover Guix related services using Avahi.\n")) | |
37 | (display (G_ " | |
38 | -c, --cache=DIRECTORY cache discovery results in DIRECTORY")) | |
39 | (display (G_ " | |
40 | -h, --help display this help and exit")) | |
41 | (display (G_ " | |
42 | -V, --version display version information and exit")) | |
43 | (newline) | |
44 | (show-bug-report-information)) | |
45 | ||
46 | (define %options | |
47 | (list (option '(#\c "cache") #t #f | |
48 | (lambda (opt name arg result) | |
49 | (alist-cons 'cache arg result))) | |
50 | (option '(#\h "help") #f #f | |
51 | (lambda _ | |
52 | (show-help) | |
53 | (exit 0))) | |
54 | (option '(#\V "version") #f #f | |
55 | (lambda _ | |
56 | (show-version-and-exit "guix discover"))))) | |
57 | ||
58 | (define %default-options | |
59 | `((cache . ,%state-directory))) | |
60 | ||
61 | \f | |
62 | ;;; | |
63 | ;;; Publish servers. | |
64 | ;;; | |
65 | ||
66 | (define %publish-services | |
67 | ;; Set of discovered publish services. | |
68 | (make-hash-table)) | |
69 | ||
70 | (define (publish-file cache-directory) | |
71 | "Return the name of the file storing the discovered publish services inside | |
72 | CACHE-DIRECTORY." | |
73 | (let ((directory (string-append cache-directory "/discover"))) | |
74 | (string-append directory "/publish"))) | |
75 | ||
76 | (define %publish-file | |
77 | (make-parameter (publish-file %state-directory))) | |
78 | ||
79 | (define* (write-publish-file #:key (file (%publish-file))) | |
80 | "Dump the content of %PUBLISH-SERVICES hash table into FILE. Use a write | |
81 | lock on FILE to synchronize with any potential readers." | |
1f49ab6e MO |
82 | (with-atomic-file-output file |
83 | (lambda (port) | |
84 | (hash-for-each | |
85 | (lambda (name service) | |
86 | (format port "http://~a:~a~%" | |
87 | (avahi-service-address service) | |
88 | (avahi-service-port service))) | |
89 | %publish-services))) | |
90 | (chmod file #o644)) | |
79f9dee3 MO |
91 | |
92 | (define* (read-substitute-urls #:key (file (%publish-file))) | |
93 | "Read substitute urls list from FILE and return it. Use a read lock on FILE | |
94 | to synchronize with the writer." | |
c952a931 | 95 | (if (file-exists? file) |
1f49ab6e MO |
96 | (call-with-input-file file |
97 | (lambda (port) | |
98 | (let loop ((url (read-line port)) | |
99 | (urls '())) | |
100 | (if (eof-object? url) | |
101 | urls | |
102 | (loop (read-line port) (cons url urls)))))) | |
c952a931 | 103 | '())) |
79f9dee3 MO |
104 | |
105 | \f | |
106 | ;;; | |
107 | ;;; Entry point. | |
108 | ;;; | |
109 | ||
110 | (define %services | |
111 | ;; List of services we want to discover. | |
112 | (list publish-service-type)) | |
113 | ||
114 | (define (service-proc action service) | |
115 | (let ((name (avahi-service-name service)) | |
116 | (type (avahi-service-type service))) | |
117 | (when (string=? type publish-service-type) | |
118 | (case action | |
119 | ((new-service) | |
120 | (hash-set! %publish-services name service)) | |
121 | ((remove-service) | |
122 | (hash-remove! %publish-services name))) | |
123 | (write-publish-file)))) | |
124 | ||
125 | (define-command (guix-discover . args) | |
126 | (category internal) | |
127 | (synopsis "discover Guix related services using Avahi") | |
128 | ||
129 | (with-error-handling | |
130 | (let* ((opts (args-fold* args %options | |
131 | (lambda (opt name arg result) | |
132 | (leave (G_ "~A: unrecognized option~%") name)) | |
133 | (lambda (arg result) | |
134 | (leave (G_ "~A: extraneous argument~%") arg)) | |
135 | %default-options)) | |
136 | (cache (assoc-ref opts 'cache)) | |
137 | (publish-file (publish-file cache))) | |
138 | (parameterize ((%publish-file publish-file)) | |
139 | (mkdir-p (dirname publish-file)) | |
ee94cd26 | 140 | (false-if-exception (delete-file publish-file)) |
79f9dee3 MO |
141 | (avahi-browse-service-thread service-proc |
142 | #:types %services))))) |