[dhcp] 09/12: dhcp: dhcp configuration objects

[Rohan Prinja]

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)