Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 197 lines (184 sloc) 8.343 kb
e1ddd16 @ursetto Initial import
authored
1 #> #include <augeas.h> <#
2
469f931 @ursetto Implement augsave modes
authored
3 ;; todo: srun; span (?); transform (?); rename (? -- needs unreleased 2012-08)
284d370 @ursetto add insert
authored
4 ;; todo: init using AUG_NO_ERR_CLOSE (requires 0.10.0). Easy, but I have no way to
5 ;; trigger a failure for testing.
99d3a31 @ursetto update todos
authored
6 ;; todo: use init/close_memstream from augeas internal.h to write FD output to memory
7 ;; for string ports for both aug_print and aug_srun. has been available since 0.2.0 (2008-06)
a02748b @ursetto use match in multiple tests
authored
8
8fb6c3b @ursetto add symbolic error type and report it in exceptions
authored
9 (use foreigners)
be334c0 @ursetto implement save, and tests assuming overwrite mode
authored
10 (use lolevel) ;; free
6ad9456 @ursetto wrap in module and add .setup & .meta
authored
11 (use srfi-1) ;; list-tabulate
8fb6c3b @ursetto add symbolic error type and report it in exceptions
authored
12
13 (define-foreign-enum-type (augeus:errcode int 'unknown)
14 (errcode->int int->errcode)
15 ((nomem) AUG_ENOMEM) ;; Out of memory
16 ((internal) AUG_EINTERNAL) ;; Internal error (bug)
17 ((pathx) AUG_EPATHX) ;; Invalid path expression
18 ((nomatch) AUG_ENOMATCH) ;; No match for path expression
19 ((mmatch) AUG_EMMATCH) ;; Too many matches for path expression
20 ((syntax) AUG_ESYNTAX) ;; Syntax error in lens file
21 ((nolens) AUG_ENOLENS) ;; Lens lookup failed
22 ((mxfm) AUG_EMXFM) ;; Multiple transforms
23 ((nospan) AUG_ENOSPAN) ;; No span for this node
24 ((mvdesc) AUG_EMVDESC) ;; Cannot move node into its descendant
25 ((cmdrun) AUG_ECMDRUN) ;; Failed to execute command
26 ((badarg) AUG_EBADARG) ;; Invalid argument in function call
48ecce3 @ursetto Remove AUG_ELABEL (not available in 0.10.0 release)
authored
27 ;; not available in 0.10.0 release
28 ;; ((label) AUG_ELABEL) ;; Invalid label
29 )
8fb6c3b @ursetto add symbolic error type and report it in exceptions
authored
30
ef056ae @ursetto implement initflags and tests
authored
31 (define-foreign-enum-type (augeas:initflag int 'unknown)
32 (initflag->int int->initflag)
33 ((none) AUG_NONE)
34 ((save-overwrite) AUG_NONE)
35 ((save-backup) AUG_SAVE_BACKUP)
36 ((save-newfile) AUG_SAVE_NEWFILE)
37 ((save-noop) AUG_SAVE_NOOP)
38 ((type-check) AUG_TYPE_CHECK)
39 ((no-stdinc) AUG_NO_STDINC) ;; better name? no-builtin-search-path?
40 ((no-load) AUG_NO_LOAD)
41 ((no-module-autoload) AUG_NO_MODL_AUTOLOAD)
42 ((enable-span) AUG_ENABLE_SPAN)
43 ;; ((no-error-close) AUG_NO_ERR_CLOSE) ;; don't expose this--we should handle it transparently
44 )
45
7c39ab4 @ursetto Add match
authored
46 (define-syntax begin0 ; multiple values discarded
47 (syntax-rules () ((_ e0 e1 ...)
48 (let ((tmp e0)) e1 ... tmp))))
49
e1ddd16 @ursetto Initial import
authored
50 (define-record augeas ptr)
b21e24c @ursetto add close; catch operations on closed handle
authored
51 (define-foreign-type augeas (c-pointer "augeas")
52 (lambda (a) (or (augeas-ptr a)
53 (error 'augeus "operation on closed handle"))))
e1ddd16 @ursetto Initial import
authored
54
55 (define _aug_init (foreign-lambda (c-pointer "augeas") aug_init c-string c-string int))
b21e24c @ursetto add close; catch operations on closed handle
authored
56 (define _aug_close (foreign-lambda void aug_close augeas))
e1ddd16 @ursetto Initial import
authored
57 (define _aug_get (foreign-lambda int aug_get augeas c-string (c-pointer c-string)))
698f549 @ursetto add/test set, setm, rm, and exists
authored
58 (define _aug_set (foreign-lambda int aug_set augeas c-string c-string))
59 (define _aug_setm (foreign-lambda int aug_setm augeas c-string c-string c-string))
60 (define _aug_rm (foreign-lambda int aug_rm augeas c-string))
9b440a6 @ursetto implement mv
authored
61 (define _aug_mv (foreign-lambda int aug_mv augeas c-string c-string))
7c03f81 @ursetto aug-match-count + test
authored
62 (define _aug_match (foreign-lambda int aug_match augeas c-string (c-pointer (c-pointer c-string))))
284d370 @ursetto add insert
authored
63 (define _aug_insert (foreign-lambda int aug_insert augeas c-string c-string bool))
a81cc09 @ursetto add print, no test
authored
64 (define _aug_print (foreign-lambda int aug_print augeas (c-pointer "FILE") c-string))
53350a0 @ursetto add load; rearrange tests
authored
65 (define _aug_load (foreign-lambda int aug_load augeas))
be334c0 @ursetto implement save, and tests assuming overwrite mode
authored
66 (define _aug_save (foreign-lambda int aug_save augeas))
6f9246f @ursetto implement defvar + tests
authored
67 (define _aug_defvar (foreign-lambda int aug_defvar augeas c-string c-string))
68 (define _aug_defnode (foreign-lambda int aug_defnode augeas c-string c-string c-string (c-pointer bool)))
e1ddd16 @ursetto Initial import
authored
69 (define _aug_error (foreign-lambda int aug_error augeas)) ;; error code
70 (define _aug_error_message (foreign-lambda c-string aug_error_message augeas)) ;; human-readable error
71 (define _aug_error_minor_message (foreign-lambda c-string aug_error_minor_message augeas)) ;; elaboration of error message
72 (define _aug_error_details (foreign-lambda c-string aug_error_details augeas)) ;; human-readable details
73
ef056ae @ursetto implement initflags and tests
authored
74 (define (aug-init #!key root loadpath (flags 'none))
75 (make-augeas (or (_aug_init root loadpath (initflag->int flags))
e1ddd16 @ursetto Initial import
authored
76 (error 'aug-init "initialization failed"))))
b21e24c @ursetto add close; catch operations on closed handle
authored
77 (define (aug-close a) ;; safe to call this multiple times
78 (when (augeas-ptr a)
79 (_aug_close a)
80 (augeas-ptr-set! a #f))
81 (void))
e1ddd16 @ursetto Initial import
authored
82 (define (aug-get a path)
83 (let-location ((v c-string))
84 (let ((rc (_aug_get a path #$v)))
85 (if (< rc 0)
86 (augeas-error a 'aug-get path)
87 v))))
698f549 @ursetto add/test set, setm, rm, and exists
authored
88 (define (aug-exists? a path)
89 (let ((rc (_aug_get a path #f)))
90 (if (< rc 0)
91 (augeas-error a 'aug-exists? path)
92 (> rc 0))))
93 (define (aug-set! a path val)
94 (let ((rc (_aug_set a path val)))
95 (if (< rc 0)
96 (augeas-error a 'aug-set! path)
97 (void))))
98 (define (aug-set-multiple! a base sub value)
99 (let ((rc (_aug_setm a base sub value)))
100 (if (< rc 0)
101 (augeas-error a 'aug-set-multiple! base sub)
102 rc)))
103 (define (aug-remove! a path)
104 (let ((rc (_aug_rm a path)))
105 (if (< rc 0)
7c03f81 @ursetto aug-match-count + test
authored
106 (augeas-error a 'aug-remove! path)
698f549 @ursetto add/test set, setm, rm, and exists
authored
107 rc)))
9b440a6 @ursetto implement mv
authored
108 (define (aug-move! a from to)
109 (let ((rc (_aug_mv a from to)))
110 (if (< rc 0)
111 (augeas-error a 'aug-move! from to)
112 (void))))
7c03f81 @ursetto aug-match-count + test
authored
113 (define (aug-match-count a path)
114 (let ((rc (_aug_match a path #f)))
115 (if (< rc 0)
7c39ab4 @ursetto Add match
authored
116 (augeas-error a 'aug-match-count path)
117 rc)))
118 (define (aug-match a path)
119 (define _aug_match_index
120 (foreign-lambda* c-string* (((c-pointer c-string) v) (int i))
18d6df9 @ursetto Properly free match array container
authored
121 "return(v[i]);"))
7c39ab4 @ursetto Add match
authored
122 (let-location ((v c-pointer))
123 (let ((rc (_aug_match a path #$v)))
124 (when (< rc 0)
125 (augeas-error a 'aug-match path))
126 (begin0
127 (list-tabulate rc (lambda (i) (_aug_match_index v i)))
18d6df9 @ursetto Properly free match array container
authored
128 (free v))))) ;; free array; elts were freed by c-string*.
284d370 @ursetto add insert
authored
129 (define (aug-insert! a path label #!optional before?)
130 (let ((rc (_aug_insert a path label before?)))
131 (when (< rc 0)
132 (augeas-error a 'aug-insert! path label))
133 (void)))
53350a0 @ursetto add load; rearrange tests
authored
134 (define (aug-load! a)
135 (when (< (_aug_load a) 0)
136 (augeas-error a 'aug-load!))
137 (void))
469f931 @ursetto Implement augsave modes
authored
138 (define (aug-save! a #!optional mode)
02b63d0 @ursetto Fix bug in check of omitted save mode
authored
139 (when (and mode
140 (not (memq mode '(overwrite backup newfile noop))))
a339d8f @ursetto Check mode argument in aug-save!
authored
141 (error 'aug-save! "Illegal save mode" mode))
469f931 @ursetto Implement augsave modes
authored
142 (let ((old-mode (and mode (aug-get a "/augeas/save")))
143 (mode (if (symbol? mode) (symbol->string mode) mode)))
144 (when (and old-mode
145 (not (string=? old-mode mode)))
146 (aug-set! a "/augeas/save" mode))
147 (when (< (_aug_save a) 0)
148 (augeas-error a 'aug-save!))
149 ;; FIXME: if save errors out, we don't restore mode. Use handle-exceptions,
150 ;; but be careful as the restore could fail too
151 (when (and old-mode
152 (not (string=? old-mode mode)))
153 (aug-set! a "/augeas/save" old-mode))
154 (void)))
6f9246f @ursetto implement defvar + tests
authored
155 (define (aug-defvar a name expr)
156 (let ((rc (_aug_defvar a name expr)))
157 (when (< rc 0)
158 (augeas-error a 'aug-defvar name expr))
159 rc))
0e78419 @ursetto implement defnode + tests
authored
160 (define (aug-defnode a name expr value)
161 (let-location ((created bool))
162 (let ((rc (_aug_defnode a name expr value #$created)))
163 (when (< rc 0)
164 (augeas-error a 'aug-defnode name expr value))
165 (values rc created))))
7c03f81 @ursetto aug-match-count + test
authored
166
ec47405 @ursetto restrict aug-print to stream ports; add print tests
authored
167 ;; (define stdout (foreign-value "stdout" c-pointer))
168
169 ;; Print matching nodes at PATH to PORT; PORT must be associated with a file descriptor and
170 ;; must consequently be a stream port, not e.g. a string port.
a81cc09 @ursetto add print, no test
authored
171 (define (aug-print a path #!optional (port (current-output-port)))
172 ;; Not sure if we need to flush before and/or after
173 (define (port->file p)
174 (##sys#check-port p 'aug-print)
ec47405 @ursetto restrict aug-print to stream ports; add print tests
authored
175 (or ((foreign-lambda* c-pointer ((scheme-object p)) "return(C_port_file(p));")
176 p)
177 (error 'aug-print "not a stream port" port)))
a81cc09 @ursetto add print, no test
authored
178 (when (< (_aug_print a (port->file port) path) 0)
179 (augeas-error a 'aug-print path))
180 (void))
181
e1ddd16 @ursetto Initial import
authored
182 (define (augeas-error a loc . args) ;; internal: raise augeas error
183 (abort
184 (make-composite-condition
185 (make-property-condition 'exn
186 'location loc
187 'message (_aug_error_message a)
188 'arguments args)
189 (make-property-condition 'augeas
190 'code (_aug_error a)
191 ;; human-readable code symbol (pathx)? or add a property condition for it?
192 'message (_aug_error_message a)
193 'minor-message (_aug_error_minor_message a)
194 'details (_aug_error_details a))
8fb6c3b @ursetto add symbolic error type and report it in exceptions
authored
195 (make-property-condition (int->errcode (_aug_error a))))))
e1ddd16 @ursetto Initial import
authored
196
Something went wrong with that request. Please try again.