;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Mathieu Othacehe ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix 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. ;;; ;;; GNU Guix 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 GNU Guix. If not, see . (define-module (gnu installer connman) #:use-module (gnu installer utils) #:use-module (guix records) #:use-module (ice-9 match) #:use-module (ice-9 popen) #:use-module (ice-9 regex) #:use-module (srfi srfi-11) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:export ( technology technology? technology-name tec

path: root/libxml2-2.9.10/doc/tutorial/images/callouts/5.png

diff options

Diffstat (limited to 'libxml2-2.9.10/doc/tutorial/images/callouts/5.png')

-rw-r--r--

libxml2-2.9.10/doc/tutorial/images/callouts/5.png

bin

0 -> 348 bytes

1 files changed, 0 insertions, 0 deletions

e-keys output))) (let ((state (assoc-ref state-keys "State"))) (if state (cond ((string=? state "offline") 'offline) ((string=? state "idle") 'idle) ((string=? state "ready") 'ready) ((string=? state "online") 'online) (else 'unknown)) (raise (condition (&message (message "Could not determine the state of connman.")))))))) (define (split-technology-list technologies) "Parse the given strings list TECHNOLOGIES, under the following format: '((\"/net/connman/technology/xxx\") (\"KEY = VALUE\") ... (\"/net/connman/technology/yyy\") (\"KEY2 = VALUE2\") ...) Return the corresponding '(((\"KEY = VALUE\") ...) ((\"KEY2 = VALUE2\") ...)) list so that each keys of a given technology are gathered in a separate list." (let loop ((result '()) (cur-list '()) (input (reverse technologies))) (if (null? input) result (let ((item (car input))) (if (string-match "/net/connman/technology" item) (loop (cons cur-list result) '() (cdr input)) (loop result (cons item cur-list) (cdr input))))))) (define (string->boolean string) (equal? string "True")) (define (connman-technologies) "Return a list of available records." (define (technology-output->technology output) (let ((keys (parse-keys output))) (technology (name (assoc-ref keys "Name")) (type (assoc-ref keys "Type")) (powered? (string->boolean (assoc-ref keys "Powered"))) (connected? (string->boolean (assoc-ref keys "Connected")))))) (let* ((output (connman "technologies")) (technologies (split-technology-list output))) (map technology-output->technology technologies))) (define (connman-enable-technology technology) "Enable the given TECHNOLOGY." (let ((type (technology-type technology))) (connman "enable" type))) (define (connman-disable-technology technology) "Disable the given TECHNOLOGY." (let ((type (technology-type technology))) (connman "disable" type))) (define (connman-scan-technology technology) "Run a scan for the given TECHNOLOGY." (let ((type (technology-type technology))) (connman "scan" type))) (define (connman-services) "Return a list of available records." (define (service-output->service path output) (let* ((service-keys (match output ((_ . rest) rest))) (keys (parse-keys service-keys))) (service (name (assoc-ref keys "Name")) (type (assoc-ref keys "Type")) (path path) (strength (and=> (assoc-ref keys "Strength") string->number)) (state (assoc-ref keys "State"))))) (let* ((out (connman "services")) (out-filtered (delete "" out)) (services-path (map (lambda (service) (match (string-split service #\ ) ((_ ... path) path))) out-filtered)) (services-output (map (lambda (service) (connman "services" service)) services-path))) (map service-output->service services-path services-output))) (define (connman-connect service) "Connect to the given SERVICE." (let ((path (service-path service))) (connman "connect" path))) (define (connman-disconnect service) "Disconnect from the given SERVICE." (let ((path (service-path service))) (connman "disconnect" path))) (define (connman-online?) (let ((state (connman-state))) (eq? state 'online))) (define (connman-connect-with-auth service password-proc) "Connect to the given SERVICE with the password returned by calling PASSWORD-PROC. This is only possible in the interactive mode of connmanctl because authentication is done by communicating with an agent. As the open-pipe procedure of Guile do not allow to read from stderr, we have to merge stdout and stderr using bash redirection. Then error messages are extracted from connmanctl output using a regexp. This makes the whole procedure even more unreliable. Raise &connman-connection-error if an error occurred during connection. Raise &connman-password-error if the given password is incorrect." (define connman-error-regexp (make-regexp "Error[ ]*([^\n]+)\n")) (define (match-connman-error str) (let ((match-error (regexp-exec connman-error-regexp str))) (and match-error (match:substring match-error 1)))) (define* (read-regexps-or-error port regexps error-handler) "Read characters from port until an error is detected, or one of the given REGEXPS is matched. If an error is detected, call ERROR-HANDLER with the error string as argument. Raise an error if the eof is reached before one of the regexps is matched." (let loop ((res "")) (let ((char (read-char port))) (cond ((eof-object? char) (raise (condition (&message (message "Unable to find expected regexp."))))) ((match-connman-error res) => (lambda (match) (error-handler match))) ((or-map (lambda (regexp) (and (regexp-exec regexp res) regexp)) regexps) => (lambda (match) match)) (else (loop (string-append res (string char)))))))) (define* (read-regexp-or-error port regexp error-handler) "Same as READ-REGEXPS-OR-ERROR above, but with a single REGEXP." (read-regexps-or-error port (list regexp) error-handler)) (define (connman-error->condition path error) (cond ((string-match "Already connected" error) (condition (&connman-already-connected-error (service path) (output error)))) (else (condition (&connman-connection-error (service path) (output error)))))) (define (run-connection-sequence pipe) "Run the connection sequence using PIPE as an opened port to an interactive connmanctl process." (let* ((path (service-path service)) (error-handler (lambda (error) (raise (connman-error->condition path error))))) ;; Start the agent. (format pipe "agent on\n") (read-regexp-or-error pipe (make-regexp "Agent registered") error-handler) ;; Let's try to connect to the service. If the service does not require ;; a password, the connection might succeed right after this call. ;; Otherwise, connmanctl will prompt us for a password. (format pipe "connect ~a\n" path) (let* ((connected-regexp (make-regexp (format #f "Connected ~a" path))) (passphrase-regexp (make-regexp "\nPassphrase\\?[ ]*")) (regexps (list connected-regexp passphrase-regexp)) (result (read-regexps-or-error pipe regexps error-handler))) ;; A password is required. (when (eq? result passphrase-regexp) (format pipe "~a~%" (password-proc)) ;; Now, we have to wait for the connection to succeed. If an error ;; occurs, it is most likely because the password is incorrect. ;; In that case, we escape from an eventual retry loop that would ;; add complexity to this procedure, and raise a ;; &connman-password-error condition. (read-regexp-or-error pipe connected-regexp (lambda (error) ;; Escape from retry loop. (format pipe "no\n") (raise (condition (&connman-password-error (service path) (output error)))))))))) ;; XXX: Find a better way to read stderr, like with the "subprocess" ;; procedure of racket that return input ports piped on the process stdin and ;; stderr. (let ((pipe (open-pipe "connmanctl 2>&1" OPEN_BOTH))) (dynamic-wind (const #t) (lambda () (setvbuf pipe 'line) (run-connection-sequence pipe) #t) (lambda () (format pipe "quit\n") (close-pipe pipe)))))


context:
space:
mode: