It seemed
like another odd instance of Blue Car Syndrome when on October 23rd, John
McCarthy died. Having just a few weeks ago decided to
(re (learn lisp)), his name all of a sudden was everywhere
(well... for sufficiently geeky values of "everywhere", anyway) -- just
when I had actually started to write my first lisp
program in a long, long time.
After my previous adventures in Go-land, which went entirely (predictably) smoothly and where everything felt comfortable, I went along and set myself up for Lisp and installed CMUCL on my Mac OS X laptop. Re-acquainting myself with some of the basics, I quickly find out that on this platform tracing recursive functions may not show the recursive calls, so I move on to my preferred OS, where I happen to install CLISP.
And that's already the first weird thing: Lisp comes in a number of dialects (Common Lisp, Scheme, Clojure, ...), but even Common Lisp has a surprisingly large number of implementations. Sure, there are, of course various C compilers as well, but the difference between the implementations is not quite as significant. And then contrast this concept with the world of Python, PHP, Perl etc., where you really only have one single interpretation of the language. For Common Lisp, there are well over ten, uhm, "common" implementations!
These different implementations require you to write certain parts of your code in an oddly convoluted ifdef-kind-of way. Consider this example of processing the given command-line arguments:
(let ((args
#+clisp ext:*args*
#+sbcl sb-ext:*posix-argv*
#+clozure (ccl::command-line-arguments)
#+gcl si:*command-args*
#+ecl (loop for i from 0 below (si:argc) collect (si:argv i))
#+cmu extensions:*command-line-strings*
#+allegro (sys:command-line-arguments)
#+lispworks sys:*line-arguments-list*
))
...)
Alright, so for the time being, I'm
going to pretend that all the world's a clisp, so I can just silently
assume ext:*args*. Now where did my getopt(3)
equivalent go? Well, there's this, but I don't want to
start my first program by pulling in and requiring external dependencies.
So I start to spend a silly amount of time in writing my own very crude
command-line option parsing routine.
Somewhat surprisingly, I am not getting frustrated. I repeatedly have to redo even simple statements as I am figuring out the more lispy way of doing things, and while I have a lot of "Wait, what? Why? Huh?" moments, I think it tickles slightly more dormant parts of my brain, so in the end I actually end up enjoying the experience. Oh, right, it's called learning, and that actually is fun! :-)
Now most of the Lisp tutorials out there are rather academically focused, with exercises illustrating tail recursion (factorial and fibonacci are very popular), but I'm more interested in using Lisp for something "practical", so I decided to write traceroute(8).
After wrangling the command-line options into a hash, I'm all ready to start the actual functionality of the program. For that, I need to open two sockets, so let's get ourselves one of these babies (UDP, to send my packets out on)
(setq send-socket (rawsock:socket :inet :dgram "udp"))
and one of these (to receive the ICMP TIME_EXCEEDED (and, ultimately, PORT_UNREACHABLE) messages).
(setq recv-socket (rawsock:socket :inet :raw 1))
Next up, we want to set the TTL on the outgoing packet to increasing values, starting with 1. Hmmm... how do we do that? (setf (rawsock:socket-option socket name &key :level) value) looks promising, what with it claiming to use setsockopt(2), but unfortunately it turns out you can only set socket-level options, not protocol-specific options. The same is true about (socket:socket-options socket-server &rest {option}*) as well as about usocket or (SBCL specific) sb-bsd-sockets.
In
other words, I can't seem to find a socket module that actually supports
setting protocol-specific socket options at all. Which kind of puts a
downer on the whole traceroute(8) business, since I can't set the
TTL. However, again, oddly, I'm not as frustrated as you'd think. I
actually enjoyed figuring out how to do things in Lisp, especially because
it let me know how much more I have to learn. I'll just write something
else...
;;;
;;; A very simple 'traceroute' implementation in Common Lisp
;;;
;;; This program does not attempt to be cross-lisp compatible. That is,
;;; we do not bother to do the various checks for the different
;;; interpreters.
;;;
;;; Let's have a trivial usage of:
;;; clisp traceroute.lisp hostname
;;;
;;; "hostname" may be an IP address or a, well, hostname.
(require "rawsock")
;;
;; "Globals"
;;
(defparameter *max-ttl* 64) ; a better way: get value from sysctl
net.inet.ip.ttl
(defparameter *port* 33434)
(defparameter *progname* "traceroute")
(defparameter *args-given* *args*)
; --- more or less generic command line argument parsing
(defparameter *arg-table*
(block nil
(setf ht (make-hash-table :test 'equal))
(setf (gethash "-m" ht) (list *max-ttl* "ttl in outgoing packets"))
(setf (gethash "-p" ht) (list *port* "UDP port used in probes"))
(return ht)))
;;
;; Functions
;;
; 'get-opt' -- not to be confused with getopt(3), this function gets a
; value from the global arg-table.
; Derived from rawsock demo.
(defun get-opt (ht opt)
"Get the specified option value based on the defauls in *ARG-TABLE*
and the parsed command line."
(let ((arg (gethash opt ht))
(dfl (gethash opt *arg-table*)))
(if arg
(handler-case (read-from-string arg)
(error (c) (error "Invalid ~S argument: ~S: ~A" opt arg c)))
(first dfl))))
; 'parse-args' -- a (very) poor man's getopt(3)
(defun parse-args (args)
"Parse the list of command line arguments into a hash table.
Use *ARG-TABLE* for help."
(setq key nil)
(setf ht (make-hash-table :test 'equal))
(loop :for arg :in args :do
(if (string= "-h" arg)
(traceroute-usage 0))
; NOTREACHED
(if (char= #\- (char arg 0))
; handling -flags here
(progn
(pop *args-given*)
(if key
(error "~a requires an argument." key))
(if (gethash arg *arg-table*)
(setq key arg)
(error "Invalid option: ~S" arg)))
; handling args here
(if (not key)
(return ht) ; we end options parsing on the first non-flag
(progn
(pop *args-given*)
(setq val (parse-integer arg))
(setf (gethash key ht) val)
(setf key nil)))))
(if (/= (list-length *args-given*) 1)
(traceroute-usage 1)
(return-from parse-args ht)))
; 'traceroute' - given a host/IP as input, send out a packet with
; increasing TTL, recording the returned TIME_EXCEEDED
; responses and printing out the hops along the way
(defun traceroute (args target)
(setq addr (rawsock:convert-address :inet target))
(if (eq addr target)
; a symbolic hostname, so try to look it up
(progn
(setq h (ignore-errors (resolve-host-ipaddr target)))
(if h
(setq addr
(rawsock:convert-address :inet
(first (hostent-addr-list h))))
(error "~a: unknown host ~a~%" *progname* target))))
; either initial input was an address, in which case we converted
; it, or we got it via hostenet-addr-list
(setq ttl 1)
(loop while (<= ttl *max-ttl*) do
(setq send-socket (rawsock:socket :inet :dgram "udp"))
(setq recv-socket (rawsock:socket :inet :raw 1))
; Gah, apparently this is not supported.
;(setf (rawsock:socket-option recv-socket nil :level :ipproto-ip) ttl)
; Here, we'd set the TTL on the outgoing packet, send it,
; then receive the ICMP packet from the recv socket,
; printing the network address/hostname.
; Break if ICMP-UNREACHABLE.
(format t "~d <hopname> (IP)~%" ttl)
(setq ttl (1+ ttl))
(rawsock:sock-close send-socket)
(rawsock:sock-close recv-socket)))
; 'traceroute-usage' -- print usage and exit with given value
(defun traceroute-usage (err)
(setq out *standard-output*)
(if (> err 0)
(setq out *error-output*))
(format out "Usage: ~a [-h] [-m max-ttl] [-p port] <hostname|ip>~%" *progname*)
(format out " -h print this usage and exit~%")
(maphash (lambda (key val)
(format out " ~A ~A (default: ~A)~%"
key (second val) (first val)))
*arg-table*)
(ext:quit err))
;;
;; 'main'
;;
(traceroute (parse-args *args*) (first *args-given*))
October 28, 2011