* tests/syscalls.scm ("set-network-interface-flags",
  "set-network-interface-address"): Accept EACCES as a valid result.
		
	
			
		
			
				
	
	
		
			128 lines
		
	
	
	
		
			4.1 KiB
		
	
	
	
		
			Scheme
		
	
	
	
	
	
			
		
		
	
	
			128 lines
		
	
	
	
		
			4.1 KiB
		
	
	
	
		
			Scheme
		
	
	
	
	
	
| ;;; GNU Guix --- Functional package management for GNU
 | ||
| ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 | ||
| ;;;
 | ||
| ;;; 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 <http://www.gnu.org/licenses/>.
 | ||
| 
 | ||
| (define-module (test-syscalls)
 | ||
|   #:use-module (guix build syscalls)
 | ||
|   #:use-module (srfi srfi-1)
 | ||
|   #:use-module (srfi srfi-64)
 | ||
|   #:use-module (ice-9 match))
 | ||
| 
 | ||
| ;; Test the (guix build syscalls) module, although there's not much that can
 | ||
| ;; actually be tested without being root.
 | ||
| 
 | ||
| (test-begin "syscalls")
 | ||
| 
 | ||
| (test-equal "mount, ENOENT"
 | ||
|   ENOENT
 | ||
|   (catch 'system-error
 | ||
|     (lambda ()
 | ||
|       (mount "/dev/null" "/does-not-exist" "ext2")
 | ||
|       #f)
 | ||
|     (compose system-error-errno list)))
 | ||
| 
 | ||
| (test-assert "umount, ENOENT/EPERM"
 | ||
|   (catch 'system-error
 | ||
|     (lambda ()
 | ||
|       (umount "/does-not-exist")
 | ||
|       #f)
 | ||
|     (lambda args
 | ||
|       ;; Both return values have been encountered in the wild.
 | ||
|       (memv (system-error-errno args) (list EPERM ENOENT)))))
 | ||
| 
 | ||
| (test-assert "mount-points"
 | ||
|   (member "/" (mount-points)))
 | ||
| 
 | ||
| (test-assert "swapon, ENOENT/EPERM"
 | ||
|   (catch 'system-error
 | ||
|     (lambda ()
 | ||
|       (swapon "/does-not-exist")
 | ||
|       #f)
 | ||
|     (lambda args
 | ||
|       (memv (system-error-errno args) (list EPERM ENOENT)))))
 | ||
| 
 | ||
| (test-assert "swapoff, ENOENT/EINVAL/EPERM"
 | ||
|   (catch 'system-error
 | ||
|     (lambda ()
 | ||
|       (swapoff "/does-not-exist")
 | ||
|       #f)
 | ||
|     (lambda args
 | ||
|       (memv (system-error-errno args) (list EPERM EINVAL ENOENT)))))
 | ||
| 
 | ||
| (test-assert "all-network-interfaces"
 | ||
|   (match (all-network-interfaces)
 | ||
|     (((? string? names) ..1)
 | ||
|      (member "lo" names))))
 | ||
| 
 | ||
| (test-assert "network-interfaces"
 | ||
|   (match (network-interfaces)
 | ||
|     (((? string? names) ..1)
 | ||
|      (lset<= string=? names (all-network-interfaces)))))
 | ||
| 
 | ||
| (test-assert "network-interface-flags"
 | ||
|   (let* ((sock  (socket AF_INET SOCK_STREAM 0))
 | ||
|          (flags (network-interface-flags sock "lo")))
 | ||
|     (close-port sock)
 | ||
|     (and (not (zero? (logand flags IFF_LOOPBACK)))
 | ||
|          (not (zero? (logand flags IFF_UP))))))
 | ||
| 
 | ||
| (test-equal "loopback-network-interface?"
 | ||
|   ENODEV
 | ||
|   (and (loopback-network-interface? "lo")
 | ||
|        (catch 'system-error
 | ||
|          (lambda ()
 | ||
|            (loopback-network-interface? "nonexistent")
 | ||
|            #f)
 | ||
|          (lambda args
 | ||
|            (system-error-errno args)))))
 | ||
| 
 | ||
| (test-skip (if (zero? (getuid)) 1 0))
 | ||
| (test-assert "set-network-interface-flags"
 | ||
|   (let ((sock (socket AF_INET SOCK_STREAM 0)))
 | ||
|     (catch 'system-error
 | ||
|       (lambda ()
 | ||
|         (set-network-interface-flags sock "lo" IFF_UP))
 | ||
|       (lambda args
 | ||
|         (close-port sock)
 | ||
|         ;; We get EPERM with Linux 3.18ish and EACCES with 2.6.32.
 | ||
|         (memv (system-error-errno args) (list EPERM EACCES))))))
 | ||
| 
 | ||
| (test-equal "network-interface-address lo"
 | ||
|   (make-socket-address AF_INET (inet-pton AF_INET "127.0.0.1") 0)
 | ||
|   (let* ((sock (socket AF_INET SOCK_STREAM 0))
 | ||
|          (addr (network-interface-address sock "lo")))
 | ||
|     (close-port sock)
 | ||
|     addr))
 | ||
| 
 | ||
| (test-assert "set-network-interface-address"
 | ||
|   (let ((sock (socket AF_INET SOCK_STREAM 0)))
 | ||
|     (catch 'system-error
 | ||
|       (lambda ()
 | ||
|         (set-network-interface-address sock "nonexistent"
 | ||
|                                        (make-socket-address
 | ||
|                                         AF_INET
 | ||
|                                         (inet-pton AF_INET "127.12.14.15")
 | ||
|                                         0)))
 | ||
|       (lambda args
 | ||
|         (close-port sock)
 | ||
|         ;; We get EPERM with Linux 3.18ish and EACCES with 2.6.32.
 | ||
|         (memv (system-error-errno args) (list EPERM EACCES))))))
 | ||
| 
 | ||
| (test-end)
 | ||
| 
 | ||
| 
 | ||
| (exit (= (test-runner-fail-count (test-runner-current)) 0))
 |