diff options
author | Anonymized <anonymous@example.com> | 2018-01-20 02:00:25 +0100 |
---|---|---|
committer | Anonymized <anonymous@example.com> | 2018-01-20 02:00:25 +0100 |
commit | f50fa35cef38cbc52862dd4ed5a8677b2eab4620 (patch) | |
tree | 41fb5b7b54a4dabad56838ac8ce727aaa23b6e5e | |
parent | c64725e90096c7902a3978fa83903264feffd2d6 (diff) | |
download | gnunet-guile2-f50fa35cef38cbc52862dd4ed5a8677b2eab4620.tar.gz gnunet-guile2-f50fa35cef38cbc52862dd4ed5a8677b2eab4620.zip |
add sync publish procedure in gnunet/sync.scm
-rw-r--r-- | gnunet/sync.scm | 84 |
1 files changed, 84 insertions, 0 deletions
diff --git a/gnunet/sync.scm b/gnunet/sync.scm new file mode 100644 index 0000000..c351a95 --- /dev/null +++ b/gnunet/sync.scm | |||
@@ -0,0 +1,84 @@ | |||
1 | ;;;; -*- mode: Scheme; indent-tabs-mode: nil; fill-column: 80; -*- | ||
2 | ;;;; | ||
3 | ;;;; Copyright © 2018 Amirouche Boubekki <amirouche@hypermove.net> | ||
4 | ;;;; | ||
5 | ;;;; This program is free software: you can redistribute it and/or modify | ||
6 | ;;;; it under the terms of the GNU General Public License as published by | ||
7 | ;;;; the Free Software Foundation, either version 3 of the License, or | ||
8 | ;;;; (at your option) any later version. | ||
9 | ;;;; | ||
10 | ;;;; This program is distributed in the hope that it will be useful, | ||
11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
13 | ;;;; GNU General Public License for more details. | ||
14 | ;;;; | ||
15 | ;;;; You should have received a copy of the GNU General Public License | ||
16 | ;;;; along with this program. If not, see <http://www.gnu.org/licenses/>. | ||
17 | (define-module (gnunet sync)) | ||
18 | |||
19 | (use-modules ((srfi srfi-1))) | ||
20 | (use-modules ((ice-9 threads))) | ||
21 | |||
22 | (use-modules ((gnunet))) | ||
23 | |||
24 | |||
25 | (define (publish/task/shutdown publish-context) | ||
26 | (lambda () | ||
27 | (fs-publish-stop publish-context))) | ||
28 | |||
29 | (define (publish/progress callback) | ||
30 | (lambda (info) | ||
31 | (let ((status (fs-progress-info-status info))) | ||
32 | (cond | ||
33 | ((eq? status %fs-status-publish-completed) | ||
34 | (callback (uri->string (fs-progress-info-publish-chk-uri info))) | ||
35 | (scheduler-shutdown)))))) | ||
36 | |||
37 | (define (publish/task configuration filename callback) | ||
38 | (lambda () | ||
39 | (let ((fs (fs-start configuration "c3b2" (publish/progress callback)))) | ||
40 | (let ((fi (fs-file-information-create-from-file | ||
41 | fs | ||
42 | filename | ||
43 | ;; TODO: doesn't work, see publish-keywords | ||
44 | (fs-uri-ksk-create "c3b2://topic") | ||
45 | (container-meta-data-create) | ||
46 | %gnunet-yes | ||
47 | (fs-block-options)))) | ||
48 | (let ((publish-context (fs-publish-start fs fi))) | ||
49 | (scheduler-add-shutdown (publish/task/shutdown publish-context))))))) | ||
50 | |||
51 | (define (publish-exec configuration filename callback) | ||
52 | (let ((configuration* (configuration-create))) | ||
53 | (configuration-load! configuration* configuration) | ||
54 | (scheduler-run (publish/task configuration* filename callback)))) | ||
55 | |||
56 | (define (publish-file configuration filename) | ||
57 | (let ((out #f)) | ||
58 | (let ((thread (call-with-new-thread | ||
59 | (lambda () | ||
60 | (publish-exec configuration | ||
61 | filename | ||
62 | (lambda (uri) (set! out uri))))))) | ||
63 | (join-thread thread)) | ||
64 | out)) | ||
65 | |||
66 | (define (invoke program . args) ;; stolen from guix | ||
67 | "Invoke PROGRAM with the given ARGS. Raise an error if the exit | ||
68 | code is non-zero; otherwise return #t." | ||
69 | (let ((status (apply system* program args))) | ||
70 | (unless (zero? status) | ||
71 | (error (format #f "program ~s exited with non-zero code" program) | ||
72 | status)) | ||
73 | #t)) | ||
74 | |||
75 | (define (publish-keywords configuration uri keywords) | ||
76 | (apply invoke (append (list "gnunet-publish" "-c" configuration "-u" uri) | ||
77 | (append-map (lambda (keyword) (list "-k" keyword)) | ||
78 | keywords)))) | ||
79 | |||
80 | (define-public (publish configuration filename keywords) | ||
81 | "Publish FILENAME tagged with keywords" | ||
82 | (let ((uri (publish-file configuration filename))) | ||
83 | (publish-keywords configuration uri keywords) | ||
84 | uri)) | ||