mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-28 07:12:30 -05:00
81 lines
3.3 KiB
Scheme
81 lines
3.3 KiB
Scheme
|
;;; GNU Guix --- Functional package management for GNU
|
||
|
;;; Copyright © 2013, 2014 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 (gnu services networking)
|
||
|
#:use-module (gnu services)
|
||
|
#:use-module (gnu packages admin)
|
||
|
#:use-module (gnu packages linux)
|
||
|
#:use-module (guix monads)
|
||
|
#:export (static-networking-service))
|
||
|
|
||
|
;;; Commentary:
|
||
|
;;;
|
||
|
;;; Networking services.
|
||
|
;;;
|
||
|
;;; Code:
|
||
|
|
||
|
(define* (static-networking-service interface ip
|
||
|
#:key
|
||
|
gateway
|
||
|
(name-servers '())
|
||
|
(inetutils inetutils)
|
||
|
(net-tools net-tools))
|
||
|
"Return a service that starts INTERFACE with address IP. If GATEWAY is
|
||
|
true, it must be a string specifying the default network gateway."
|
||
|
|
||
|
;; TODO: Eventually we should do this using Guile's networking procedures,
|
||
|
;; like 'configure-qemu-networking' does, but the patch that does this is
|
||
|
;; not yet in stock Guile.
|
||
|
(mlet %store-monad ((ifconfig (package-file inetutils "bin/ifconfig"))
|
||
|
(route (package-file net-tools "sbin/route")))
|
||
|
(return
|
||
|
(service
|
||
|
(documentation
|
||
|
(string-append "Set up networking on the '" interface
|
||
|
"' interface using a static IP address."))
|
||
|
(provision '(networking))
|
||
|
(start `(lambda _
|
||
|
;; Return #t if successfully started.
|
||
|
(and (zero? (system* ,ifconfig ,interface ,ip "up"))
|
||
|
,(if gateway
|
||
|
`(zero? (system* ,route "add" "-net" "default"
|
||
|
"gw" ,gateway))
|
||
|
#t)
|
||
|
,(if (pair? name-servers)
|
||
|
`(call-with-output-file "/etc/resolv.conf"
|
||
|
(lambda (port)
|
||
|
(display
|
||
|
"# Generated by 'static-networking-service'.\n"
|
||
|
port)
|
||
|
(for-each (lambda (server)
|
||
|
(format port "nameserver ~a~%"
|
||
|
server))
|
||
|
',name-servers)))
|
||
|
#t))))
|
||
|
(stop `(lambda _
|
||
|
;; Return #f is successfully stopped.
|
||
|
(not (and (system* ,ifconfig ,interface "down")
|
||
|
(system* ,route "del" "-net" "default")))))
|
||
|
(respawn? #f)
|
||
|
(inputs `(("inetutils" ,inetutils)
|
||
|
,@(if gateway
|
||
|
`(("net-tools" ,net-tools))
|
||
|
'())))))))
|
||
|
|
||
|
;;; networking.scm ends here
|