[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[dhcp] 09/12: dhcp: dhcp configuration objects
From: |
Rohan Prinja |
Subject: |
[dhcp] 09/12: dhcp: dhcp configuration objects |
Date: |
Sat, 06 Jun 2015 18:16:58 +0000 |
wenderen pushed a commit to branch master
in repository dhcp.
commit 41bba08b608a1b007177369f89cd1787b3cb4616
Author: Rohan Prinja <address@hidden>
Date: Sat Jun 6 23:44:10 2015 +0530
dhcp: dhcp configuration objects
---
dhcp/dhcp.scm | 159 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 159 insertions(+), 0 deletions(-)
diff --git a/dhcp/dhcp.scm b/dhcp/dhcp.scm
new file mode 100644
index 0000000..4805450
--- /dev/null
+++ b/dhcp/dhcp.scm
@@ -0,0 +1,159 @@
+;;; GNU Guix DHCP Client.
+;;;
+;;; Copyright 2015 Free Software Foundation, Inc.
+;;;
+;;; This program 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.
+;;;
+;;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
+
+(add-to-load-path (string-append (dirname (current-filename))
+ "/.."))
+
+(define-module (dhcp dhcp)
+ #:export (<dhcp>
+ dhcp-start
+ dhcp-renew
+ dhcp-release
+ dhcp-stop
+ dhcp-inform
+ get-most-recent-lease))
+
+(use-modules (dhcp messages)
+ (oop goops)
+ (rnrs base)
+ (ice-9 regex)
+ ((srfi srfi-1) #:select (find)))
+
+; Class for DHCP objects.
+; A <dhcp> object is held by an interface, and contains
+; information about the configuration process for that
+; specific interface.
+(define-class <dhcp> ()
+ ; transaction identifier of last sent request
+ xid
+ ; number of retries for current request
+ tries
+ ; current state, see Page 34, RFC 2131 for the transition diagram
+ (state #:init-form 'DHCP-INIT
+ #:init-keyword #:state)
+
+ t1_renew_time ; time until next renew try
+ t2_rebind_time ; time until next rebind try
+ lease_ack ; time since last DHCPACK
+ t0_timeout ; time until lease expiry
+
+ offered_ip_addr
+ offered_sn_mask
+ offered_gw_addr
+
+ offered_t0_lease
+ offered_t1_renew
+ offered_t2_rebind
+
+ (config-started-at #:init-form 0)
+ dhcpdiscover-sent-at)
+
+; config-start: time when config process began
+; dhcpdiscover-sent-at: time at which most recent
+; DHCPDISCOVER packet was sent
+; config-start and dhcpdiscover-sent-at are stored
+; as seconds since epoch
+
+; TODO: make a separate lease file for each interface rather than
+; logging all interfaces into the same log file. This means no "interface"
+; field in the leases file. Apart from this, the file format is the same
+; as that of dhclient. See dhclient.conf (5) for more information.
+(define *leases-file* "/var/lib/dhcp/dhclient.leases")
+
+(define (parse-lease-string lease-str)
+ "Parse the lease string returned by (get-most-recent-lease)
+into a list of options."
+ (let* ((prefix "(option )?")
+ (name "([a-z]|-)+ ")
+ (value "([0-9]|\\.|\\/| |:)+")
+ (regex (string-append prefix name value)))
+ (map match:substring (list-matches regex lease-str))))
+
+(define (get-fixed-address parsed-lease)
+ "Grab the IPv4 address from the list of property->value
+mappings for a single lease."
+ (let* ((line (find (lambda (s)
+ (string-prefix? "fixed-address" s))
+ parsed-lease))
+ (pair (string-split line #\space))
+ (iaddr-str (cadr pair))
+ (iaddr (inet-pton AF_INET iaddr-str)))
+ iaddr))
+
+(define (get-most-recent-lease)
+ "Read the dhcp client leases file and obtain the
+most recent lease."
+ (if (file-exists? *leases-file*)
+ (let* ((port (open-input-file *leases-file*))
+ (_ (seek port -2 SEEK_END))
+ (last-char (peek-char port))
+ (_ (assert (eq? last-char #\})))
+ (lease-ls (find-lease port))
+ (lease-str (list->string lease-ls)))
+ lease-str)
+ #f))
+
+(define (find-lease port)
+ "Utility function used while parsing the leases file.
+At the time of calling, 'port' is such that the file
+descriptor port is pointing to the char just before
+the last } in the file. This function seeks back
+the port until it finds a { to match the }."
+ (define (helper port buffer)
+ (if (eq? (peek-char port) #\{)
+ buffer
+ (begin
+ (seek port -1 SEEK_CUR)
+ (helper port (cons (peek-char port) buffer)))))
+ (assert (file-port? port))
+ (helper port '(#\})))
+
+(define (wait-desync)
+ "Wait for a random amount of time between 1 and 10 seconds
+to desynchronize from other clients in the subnet."
+ (let ((waiting-time (+ 1 (random 10))))
+ (begin
+ (display (format #f "wait-desync: sleeping for ~a seconds\n"
waiting-time))
+ (sleep waiting-time)
+ (display "wait-desync: done sleeping\n"))))
+
+(define (dhcp-start netif)
+ "Begin the configuration process for the network
+interface NETIF."
+ (let ((dhcp-state (if (ip-addr-known?)
+ 'DHCP-INIT-REBOOT
+ 'DHCP-INIT)))
+ (display (format #f "start-config: entered ~a state\n" dhcp-state))
+ (slot-set! (slot-ref netif 'dhcp) (current-time))
+ (if (eq? dhcp-state 'INIT)
+ (begin
+ (wait-desync)
+ 'TODO)
+ 'TODO)))
+
+(define (dhcp-renew netif) 'TODO)
+
+(define (dhcp-release netif) 'TODO)
+
+(define (dhcp-stop netif) 'TODO)
+
+(define (dhcp-inform netif) 'TODO)
+
+(define (dhcp-arp-check netif ipaddr)
+ "Perform an ARP check to see if an IP address
+is already in use."
+ #f)
- [dhcp] branch master updated (30d7a60 -> d6b11dd), Rohan Prinja, 2015/06/06
- [dhcp] 02/12: dhcp: tell git to ignore log files, Rohan Prinja, 2015/06/06
- [dhcp] 05/12: dhcp: add in deprecated time-offset option, Rohan Prinja, 2015/06/06
- [dhcp] 01/12: dhcp: arp hardware address identifiers, Rohan Prinja, 2015/06/06
- [dhcp] 04/12: dhcp: change module names to reflect directory structure, Rohan Prinja, 2015/06/06
- [dhcp] 08/12: dhcp: code for sending packets, incomplete, untested, Rohan Prinja, 2015/06/06
- [dhcp] 10/12: dhcp: source for .so, used by some now-redundant functions in interfaces.scm, Rohan Prinja, 2015/06/06
- [dhcp] 06/12: dhcp: packet objects, untested, Rohan Prinja, 2015/06/06
- [dhcp] 03/12: dhcp: add unused and private-use options, fix some other mistakes, Rohan Prinja, 2015/06/06
- [dhcp] 09/12: dhcp: dhcp configuration objects,
Rohan Prinja <=
- [dhcp] 07/12: dhcp: code to read info about network interfaces, untested, Rohan Prinja, 2015/06/06
- [dhcp] 12/12: dhcp: client code, incomplete, Rohan Prinja, 2015/06/06
- [dhcp] 11/12: dhcp: tests for the (dhcp *) modules, incomplete, Rohan Prinja, 2015/06/06