Removed some obsolete messages from sv.po.
[doldaconnect.git] / clients / gnome-trans-applet / dctrmon
1 #!/usr/bin/guile \
2 --debug -s
3 !#
4
5 (use-modules (dolcon ui))
6 (use-modules (ice-9 popen))
7 (use-modules (ice-9 pretty-print))
8
9 (define (flush port)
10   (force-output port))
11
12 (define idlist '())
13 (define filter '())
14 (define (filtered tag filter)
15   (and (pair? filter)
16        (or (equal? (car filter) (substring tag 0 (min (string-length (car filter)) (string-length tag))))
17            (filtered tag (cdr filter)))))
18 (catch 'system-error
19        (lambda ()
20          (let ((port (open-input-file (string-append (getenv "HOME") "/.dctrmon-defines"))) (form #f))
21            (while (begin (set! form (read port)) (not (eof-object? form)))
22                   (primitive-eval form))))
23        (lambda args
24          #f))
25
26
27 (define krbcc (string-append "/tmp/krb5cc_dcmon_" (number->string (getuid)) "_XXXXXX"))
28 (close-port (mkstemp! krbcc))
29 (setenv "KRB5CCNAME" (string-append "FILE:" krbcc))
30 (sigaction SIGCHLD SIG_DFL)
31 (define pid (primitive-fork))
32 (if (= pid 0)
33     (begin (execlp "kinit" "kinit" "-f" "-r" "10d" "-k" "-t" (string-append (getenv "HOME") "/.myprinc.keytab") (string-append (passwd:name (getpwuid (getuid))) "/dcview"))
34            (exit 1))
35     (if (not (= (cdr (waitpid pid)) 0))
36         (exit 1)))
37 (dc-c&l #f (getenv "DCSERVER") #t)
38 (delete-file krbcc)
39
40 (dc-ecmd-assert 200 "notify" "all" "on")
41
42 (display "C\n")
43
44 (let ((resp (dc-ecmd-assert '(200 201) "lstrans")))
45   (if (and resp (= (cdr (assoc 'code (dc-extract resp))) 200))
46       (for-each (lambda (o)
47                   (if (= (cadr o) 2)
48                       (catch 'bad-return
49                              (lambda ()
50                                (for-each (lambda (a)
51                                            (if (and (equal? (car a) "tag") (filtered (cadr a) filter))
52                                                (begin
53                                                  (display (string-append "N\t" (cadr a) "\t" (number->string (list-ref o 6)) "\t" (number->string (list-ref o 7)) "\n"))
54                                                  (set! idlist (append idlist (list (cons (car o) (cadr a))))))))
55                                          (dc-intall (dc-ecmd-assert 200 "lstrarg" (car o)))))
56                              (lambda args #f))))
57                 (dc-intall resp))))
58
59 (flush (current-output-port))
60
61 (while #t
62        (dc-select 10000)
63        (while (let ((resp (dc-getresp)))
64                 (if resp
65                     (begin
66                       (let* ((er (dc-extract resp)) (code (cdr (assoc 'code er))) (cmd (cdr (assoc 'cmd er))) (ir (dc-intresp resp)))
67                         (if (equal? cmd ".notify")
68                             (case code
69                               ((610)
70                                (let* ((id (car ir)) (ir2 (dc-intall (dc-ecmd-assert '(200 201) "lstrarg" id))) (tag (if (eq? (car ir2) '()) #f (assoc "tag" ir2))))
71                                  (if (and tag (filtered (cadr tag) filter))
72                                      (begin (display (string-append "N\t" (cadr tag) "\t-1\t-1\n"))
73                                             (flush (current-output-port))
74                                             (set! idlist (append idlist (list (cons (car ir) (cadr tag)))))))))
75                               ((613)
76                                (let ((id (car ir)))
77                                  (if (assoc id idlist)
78                                      (begin (display (string-append "S\t" (cdr (assoc id idlist)) "\t" (number->string (cadr ir)) "\n"))
79                                             (flush (current-output-port))))))
80                               ((615)
81                                (let ((id (car ir)))
82                                  (if (assoc id idlist)
83                                      (begin (display (string-append "P\t" (cdr (assoc id idlist)) "\t" (number->string (cadr ir)) "\n"))
84                                             (flush (current-output-port))))))
85                               ((617)
86                                (let ((id (car ir)))
87                                  (if (assoc id idlist)
88                                      (begin (display (string-append "D\t" (cdr (assoc id idlist)) "\n"))
89                                             (flush (current-output-port)))))))))
90                       #t)
91                     #f)) #f))
92
93 (dc-disconnect)