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/>.

(define-module (dhcp dhcp)
  #:use-module (dhcp messages)
  #:use-module (rnrs base)
  #:use-module (ice-9 regex)
  #:use-module (srfi srfi-9)
  #:use-module ((srfi srfi-1) #:select (find))
  #:export (<dhcp>
	    dhcp-xid set-dhcp-xid!
	    dhcp-state set-dhcp-state!
	    dhcp-tries set-dhcp-tries!
	    
	    dhcp-ip-addr set-dhcp-ip-addr!
	    dhcp-sn-mask set-dhcp-sn-mask!
	    dhcp-gw-addr set-dhcp-gw-addr!
	    
	    dhcp-config-start set-dhcp-config-start!
	    
	    dhcp-start
	    dhcp-renew
	    dhcp-release
	    dhcp-stop
	    dhcp-inform
	    
	    get-most-recent-lease
	    generate-different-xid
	    generate-random-xid))

;; Record type for DHCP objects.
;; A <dhcp> record is held by an interface, and contains
;; information about the configuration process for that
;; specific interface.
(define-record-type <dhcp>
  (make-dhcp xid state tries
	     t0 t1 t2
	     lease-ack
	     ip-addr sn-mask gw-addr)

  dhcp?

  (xid dhcp-xid set-dhcp-xid!)
  (state dhcp-state set-dhcp-state!) ; see Page 34, RFC 2131 for the state transition diagram
  (tries dhcp-tries set-dhcp-tries!) ; number of retries for current request

  (t0 dhcp-t0) ; time until lease expiry
  (t1 dhcp-t1) ; time until next renew try
  (t2 dhcp-t2) ; time until next rebind try
  (lease-ack dhcp-lease-ack) ; time since last DHCPACK

  ;; Offered IP address, subnet mask and gateway address.
  (ip-addr dhcp-ip-addr set-dhcp-ip-addr!)
  (sn-mask dhcp-sn-mask set-dhcp-sn-mask!)
  (gw-addr dhcp-gw-addr set-dhcp-gw-addr!)

  ;; Time at which configuration process was started.
  (config-start dhcp-config-start set-dhcp-config-start!))

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

;; Generate a new, different transaction id for
;; a dhcp object. We simply increment the old one.
(define-syntax-rule (generate-different-xid dhcp)
  (1+ (dhcp-xid dhcp)))

;; 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! (net-iface-dhcp netif) (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)