dhcp/dhcp/dhcp.scm

;;; GNU Guix DHCP Client.
;;;
;;; Copyright © 2015 Rohan Prinja <rohan.prinja@gmail.com>
;;;
;;; 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
	    generate-different-xid
	    generate-random-xid))

(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 (current-time))
  dhcpdiscover-sent-at)

; Generate a random 32-bit number to be used as
; a transaction id.
(define (generate-random-xid)
  (random (expt 2 32)))

(define-method (generate-different-xid (dhcp <dhcp>))
  "Generate a new, different transaction id for
a dhcp object. We simply increment the old one."
  (1+ (slot-ref dhcp 'xid)))

; 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)