(defclass pcap ()
  ((pcap_t
    :initform nil
    :documentation "Foreign pointer to pcap structure.")
   (callback
    :initform nil
    :documentation "Foreign callback for packet handler.")
   (interface
    :initarg :interface
    :reader pcap-interface
    :initform nil
    :documentation "Interface to capture packets from.")
   (snaplen
    :initarg :snaplen
    :reader pcap-snaplen
    :initform 1600 ; Same as tcpdump, 68 enough for headers
    :documentation "How many bytes to capture per packet received.")
   (promisc
    :initarg :promisc
    :reader pcap-promisc
    :initform nil
    :documentation "True if capturing in promiscuous mode.")
   (timeout
    :initarg :timeout
    :reader pcap-timeout
    :initform 1
    :documentation "Read timeout in milliseconds. 0 will wait forever.")
   (datalink
    :reader pcap-datalink
    :initform nil
    :documentation "Datalink protocol for this device.")
   (buffer
    :reader pcap-buffer
    :initform nil
    :documentation "Packet buffer to hold captured packets.")
   (handler
    :initform nil
    :documentation "Lisp packet handler for capture. Called by callback.")
   (live
    :reader pcap-live
    :initform nil
    :documentation "Packet capture object is live.")))


(defmethod initialize-instance :after ((cap pcap) &key)
  (with-slots (pcap_t callback interface snaplen promisc timeout datalink
                      buffer handler live)
      cap
    (with-error-buffer (eb)
      ;; No interface given, call lookupdev to get one
      (when (null interface)
        (let ((res (%pcap-lookupdev eb)))
          (when (null res)
            (error 'network-interface-error :text
                   (error-buffer-to-lisp eb)))
          (setf interface res)))
      (clear-error-buffer eb)
      ;; Open interface for capture
      (let* ((res (%pcap-open-live interface snaplen promisc timeout eb))
             (ebtext (error-buffer-to-lisp eb)))
        (when (null-pointer-p res)
          (error 'network-interface-error :text ebtext))
        (setf pcap_t res)
        ;; Supported datalink test
        (let ((dlink (rassoc (%pcap-datalink pcap_t) *supported-datalinks*)))
          (if (not dlink)
              (progn
                (%pcap-close pcap_t)
                (error 'network-interface-error :text
                       "Unsupported datalink protocol"))
              (setf datalink (car dlink))))
        (when (not (= 0 (length ebtext)))
          (warn ebtext))
        (setf buffer (make-array snaplen :element-type
                                        '(unsigned-byte 8)))
        (setf callback 
                        (defcallback pcap-handler :void
                            ((user :pointer) (pkthdr :pointer)
                             (bytes :pointer))
                          (with-foreign-slots ((caplen len) pkthdr pcap_pkthdr)
                            ;; Copy packet data from C to lisp
                            #+:sbcl
                            (let ((dst (sb-sys:vector-sap buffer)))
                              (%memcpy dst bytes caplen))
                            #-:sbcl
                            (loop for i from 0 to (- caplen 1) do
                                 (setf (aref buffer i)
                                       (mem-aref bytes :uint8 i)))
                            ;; Call lisp packet handler
                            (funcall handler caplen len))))
        (setf live t)))))