Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

341 lines (308 sloc) 12.832 kB
(use augeas)
(use test)
(use files)
(define-syntax expect-error ;; return #t on augeas error code, else throw error
(syntax-rules ()
((_ code e0 e1 ...)
(condition-case (begin e0 e1 ...)
((exn augeas code) #t)))))
(define-syntax begin0 ; multiple values discarded
(syntax-rules () ((_ e0 e1 ...)
(let ((tmp e0)) e1 ... tmp))))
(define (aug-match-pairs a path)
(map (lambda (x) (cons x (aug-get a x)))
(aug-match a path)))
(define root "root")
;; (define root "tests/root") ;; if testing with system egg from main dir
(define (pn fn)
(make-pathname root fn))
(define (delete-files . files)
(for-each (lambda (fn)
(when (file-exists? fn) (delete-file fn)))
files))
;; get to known file state
(define (known-file-state!)
(file-copy (pn "etc/hosts.pristine")
(pn "etc/hosts")
#t)
(delete-files (pn "etc/hosts.augsave") (pn "etc/hosts.augnew")))
(known-file-state!)
(define a (aug-init root: root))
(test-group
"exists"
(test "existent" #t
(aug-exists? a "/files/etc/hosts/1/ipaddr"))
(test "existent node with no value" #t
(aug-exists? a "/files/etc/hosts/1"))
(test "non-existent" #f
(aug-exists? a "/files/etc/hosts/1/ipadd")))
(test-group
"get"
(test "get hosts/ipaddr" "127.0.0.1" (aug-get a "/files/etc/hosts/1/ipaddr"))
(test "get missing node" #f (aug-get a "/files/etc/hosts/1/missing"))
(test "get too many matches" #t
(expect-error mmatch (aug-get a "/files/etc/hosts//alias")))
(test "get invalid path expression" #t
(expect-error pathx (aug-get a "/files/etc/hosts/alias["))))
(test-group
"match"
(test "match count hosts/*/ipaddr" 2
(aug-match-count a "/files/etc/hosts/*/ipaddr")) ; hosts/1 and hosts/2
(test "match hosts/*/ipaddr"
'("/files/etc/hosts/1/ipaddr" "/files/etc/hosts/2/ipaddr")
(aug-match a "/files/etc/hosts/*/ipaddr"))
(test "match hosts" ;; probably a redundant test
'("/files/etc/hosts/#comment[1]" "/files/etc/hosts/#comment[2]"
"/files/etc/hosts/1" "/files/etc/hosts/#comment[3]"
"/files/etc/hosts/#comment[4]" "/files/etc/hosts/2")
(aug-match a "/files/etc/hosts/*")))
(test-group
"init"
;; Init DB and verify /augeas/save is set to proper flag. We'll test that
;; saving actually works later.
(define (test-cfg label flags)
(let ((a (aug-init flags: (append flags '(no-load no-module-autoload)))))
(begin0 (aug-get a (string-append "/augeas/" label))
(aug-close a))))
(test "save default" "overwrite"
(test-cfg "save" '()))
(test "save overwrite" "overwrite"
(test-cfg "save" '(save-overwrite)))
(test "save noop" "noop"
(test-cfg "save" '(save-noop)))
(test "save newfile" "newfile"
(test-cfg "save" '(save-newfile)))
(test "save backup" "backup"
(test-cfg "save" '(save-backup)))
(test-assert
"do not load files (no-load)"
(let ((a (aug-init root: root flags: '(no-load))))
(begin0
(and (= 0 (aug-match-count a "/files//*"))
(< 0 (aug-match-count a "/augeas/load//*")))
(aug-close a))))
(test-assert
"do not load files or modules (no-load + no-module-autoload)"
(let ((a (aug-init root: root flags: '(no-load no-module-autoload))))
(begin0
(and (= 0 (aug-match-count a "/files//*"))
(= 0 (aug-match-count a "/augeas/load//*")))
(aug-close a))))
(test "span disabled by default" "disable"
(test-cfg "span" '()))
(test "span enabled" "enable"
(test-cfg "span" '(enable-span)))
;; Untested: no-stdinc, type-check
)
(test-group
"set"
;; rm ipaddr node, or reload
(test "assert nonexistent" #f
(aug-get a "/files/etc/hosts/01/ipaddr"))
(test "set!" (void)
(aug-set! a "/files/etc/hosts/01/ipaddr" "192.168.5.4"))
(test "get" "192.168.5.4"
(aug-get a "/files/etc/hosts/01/ipaddr"))
(test "set! > 1 match" #t
(expect-error mmatch
(aug-set! a "/files/etc/hosts//ipaddr" "192.168.5.5"))))
(test-group
"rm"
(let ((p "/files/etc/hosts/01/ipaddr")
(v "192.168.5.4"))
(test "set!" (void) (aug-set! a p v))
(test "assert get" v (aug-get a p))
(test "rm" 1 (aug-remove! a "/files/etc/hosts/01/ipaddr"))
(test "assert get missing" #f (aug-get a p))))
(test-group
"load"
(test "verify initial state"
'(("/files/etc/hosts/1/ipaddr" . "127.0.0.1")
("/files/etc/hosts/2/ipaddr" . "172.31.122.14"))
(aug-match-pairs a "/files/etc/hosts/*/ipaddr"))
(test "update ip addresses" #t
(begin
(aug-set! a "/files/etc/hosts/1/ipaddr" "192.168.2.4")
(aug-set! a "/files/etc/hosts/2/ipaddr" "192.168.2.4")
#t))
;; We do the above instead of set-multiple! so we can do this before testing set-multiple!
;; (test "set multiple" 2
;; (aug-set-multiple! a "/files/etc/hosts/*/ipaddr" #f "192.168.2.4"))
(test "verify updated state"
'(("/files/etc/hosts/1/ipaddr" . "192.168.2.4")
("/files/etc/hosts/2/ipaddr" . "192.168.2.4"))
(aug-match-pairs a "/files/etc/hosts/*/ipaddr"))
(test-assert "load"
(aug-load! a))
(test "verify reverted state" ;; well, part of it, anyway
'(("/files/etc/hosts/1/ipaddr" . "127.0.0.1")
("/files/etc/hosts/2/ipaddr" . "172.31.122.14"))
(aug-match-pairs a "/files/etc/hosts/*/ipaddr")))
;; FIXME: match would be better here
(test-group
"set multiple, rm multiple"
(test "set multiple" 2
(aug-set-multiple! a "/files/etc/hosts/*[label() != '#comment']"
"test" "foo"))
(test "verify existence"
'("/files/etc/hosts/1/test" "/files/etc/hosts/2/test")
(aug-match a "/files/etc/hosts/*/test"))
(test "rm multiple" 2
(aug-remove! a "/files/etc/hosts/*/test"))
(test "verify non-existence" '()
(aug-match a "/files/etc/hosts/*/test")))
(test-group
"insert"
(test "verify initial state"
'(("/files/etc/hosts/1/alias[1]" . "localhost")
("/files/etc/hosts/1/alias[2]" . "galia.watzmann.net")
("/files/etc/hosts/1/alias[3]" . "galia"))
(aug-match-pairs a "/files/etc/hosts/1/alias"))
(test-assert "insert before"
(aug-insert! a "/files/etc/hosts/1/alias[2]" "alias" #t))
(test-assert "insert after"
(aug-insert! a "/files/etc/hosts/1/alias[3]" "alias"))
(test "verify inserted state"
'(("/files/etc/hosts/1/alias[1]" . "localhost")
("/files/etc/hosts/1/alias[2]" . #f)
("/files/etc/hosts/1/alias[3]" . "galia.watzmann.net")
("/files/etc/hosts/1/alias[4]" . #f)
("/files/etc/hosts/1/alias[5]" . "galia"))
(aug-match-pairs a "/files/etc/hosts/1/alias"))
;; (aug-load! a)
;; ;; or, instead of load!, we can do:
(aug-remove! a "/files/etc/hosts/1/alias[4]")
(aug-remove! a "/files/etc/hosts/1/alias[2]")
(test "verify state after removal"
'(("/files/etc/hosts/1/alias[1]" . "localhost")
("/files/etc/hosts/1/alias[2]" . "galia.watzmann.net")
("/files/etc/hosts/1/alias[3]" . "galia"))
(aug-match-pairs a "/files/etc/hosts/1/alias")
))
(test-group
"move"
(test-assert "set /a/b"
(aug-set! a "/a/b" "foo"))
(test-assert "move /a/b /x/y"
(aug-move! a "/a/b" "/x/y"))
(test "verify dest exists" "foo"
(aug-get a "/x/y"))
(test "verify src does not exist" #f
(aug-exists? a "/a/b"))
(test-assert "delete dest"
(aug-remove! a "/x/y")))
(test-group
"defvar"
(test "$hosts is undefined" #t
(expect-error pathx (aug-get a "$hosts/1/ipaddr")))
(test "defvar $hosts" 1
(aug-defvar a "hosts" "/files/etc/hosts"))
(test "get $hosts/1/ipaddr" "127.0.0.1"
(aug-get a "$hosts/1/ipaddr"))
(test "un-defvar $hosts" 0
(aug-defvar a "hosts" #f))
(test "$hosts is undefined again" #t
(expect-error pathx (aug-get a "$hosts/1/ipaddr")))
(test "defvar $ipaddrs" 2 ;; confirm nodeset works
(aug-defvar a "ipaddrs" "/files/etc/hosts//ipaddr"))
(test "undefvar $ipaddrs" 0
(aug-defvar a "ipaddrs" #f))
;; we do not test definition error (bad path, probably)
)
(test-group
"defnode"
(test "defnode $myalias, appending new node with last()+1"
'(1 #t)
(receive (aug-defnode a "myalias" "/files/etc/hosts/1/alias[last()+1]"
"crichton.xorinia.dim")))
;; does not set here, as node exists. only sets if creates
(test "defnode $myalias1 as same node as $myalias, using last()"
'(1 #f)
(receive (aug-defnode a "myalias1" "/files/etc/hosts/1/alias[last()]"
"crichton2.xorinia.dim")))
(test "get $myalias (original value, defnode does not modify existing nodes)"
"crichton.xorinia.dim" (aug-get a "$myalias"))
(test "get $myalias1 (same as $myalias)" "crichton.xorinia.dim"
(aug-get a "$myalias1"))
(test "remove $myalias" 1
(aug-remove! a "$myalias"))
(test "verify $myalias removed" #f (aug-get a "$myalias"))
(test "verify $myalias1 removed" #f (aug-get a "$myalias1"))
(test "undefine node vars" 0
(+
(aug-defvar a "myalias" #f)
(aug-defvar a "myalias1" #f))))
;; Unfortunately we can't output to string, only stream, so we have to
;; write and read a file to check the output.
(test-group
"print"
(test "print host node to a file and verify output"
;; note that EOF heredoc eats the final newline
#<<EOF
/files/etc/hosts/1
/files/etc/hosts/1/ipaddr = "127.0.0.1"
/files/etc/hosts/1/canonical = "localhost.localdomain"
/files/etc/hosts/1/alias[1] = "localhost"
/files/etc/hosts/1/alias[2] = "galia.watzmann.net"
/files/etc/hosts/1/alias[3] = "galia"
EOF
(let ((fn (create-temporary-file))) ;; insecure
(call-with-output-file fn (lambda (p) (aug-print a "/files/etc/hosts/1" p)))
(begin0
(with-input-from-file fn read-string)
(delete-file fn)))))
;; Library note: aug_load will reload a file if it's been modified in memory
;; OR if its mtime (to the second) differs from the last load or save time.
;; Therefore if you save a file, modify it externally, and load it
;; all within one second, the changes will not be picked up. (as of 0.10.0)
(test-group
"save"
(define (file-compare fn1 fn2)
(string=? (with-input-from-file fn1 read-string)
(with-input-from-file fn2 read-string)))
(test "baseline: verify pristine and sullied files differ" #f
(file-compare (pn "etc/hosts.pristine") (pn "etc/hosts.sullied")))
(define (test-save-mode mode new-file-name #!optional backup-file-name)
(test-group
(symbol->string (or mode 'default))
(known-file-state!) ;; pristine, angel!
(test "baseline: verify current and sullied files differ" #f ;; overkill but hey
(file-compare (pn "etc/hosts") (pn "etc/hosts.sullied")))
(test "baseline: verify current and pristine files identical" #t
(file-compare (pn "etc/hosts") (pn "etc/hosts.pristine")))
(test-assert "load"
(begin
;; trick augeas into reloading externally modified file
(aug-set! a "/augeas/files/etc/hosts/mtime" #f) ;; "0" works too
(aug-load! a)))
(test "verify original file ipaddr"
"127.0.0.1"
(aug-get a "/files/etc/hosts/1/ipaddr"))
(test-assert "set new ipaddr"
(aug-set! a "/files/etc/hosts/1/ipaddr" "33.34.35.36"))
(test-assert "update file"
(if mode
(aug-save! a mode)
(aug-save! a))) ;; explicitly test default, even though #f allowed
(test-assert "verify current and sullied files now identical"
(file-compare (pn new-file-name) (pn "etc/hosts.sullied")))
(when backup-file-name
(test-assert "verify backup and pristine files still identical"
(file-compare (pn backup-file-name) (pn "etc/hosts.pristine"))))
))
(test-save-mode 'overwrite "etc/hosts")
(test-save-mode 'backup "etc/hosts" "etc/hosts.augsave")
(test-save-mode 'newfile "etc/hosts.augnew" "etc/hosts")
(test-save-mode #f "etc/hosts")
(known-file-state!))
;; Must come at end of tests; closes handle
(test-group
"close"
(test "verify handle is open" #t
(aug-exists? a "/files/etc/hosts/1/ipaddr"))
(test-assert "close handle" ;; return val unspecified, in practice void
(aug-close a))
(test-assert "duplicate close ignored" ;; return val unspecified, in practice void
(aug-close a))
(test-error "error: operation on closed handle"
(aug-exists? a "/files/etc/hosts/1/ipaddr")))
Jump to Line
Something went wrong with that request. Please try again.