#!/usr/physics/gauche/bin/gosh

(use srfi-1)
(use srfi-13)
(use srfi-19)
(use gauche.process)
(use file.util)
(use text.html-lite)
(use text.tree)

(define SNMPWALK "/usr/physics/net-snmp/bin/snmpbulkwalk")
(define LDAPTHING "/usr/physics/ldaptools/bin/ldaphost")

(define snmp-fields '(
( "hrDeviceDescr.1"        "Type" )
( "mib-2.43.16.5.1.2.1."   "Panel" )
( "mib-2.43.18.1.1.8.1.36" "Error" )
( "mib-2.43.11.1.1.6.1."   "Consumable" )
))

(define printer-list '( "beech" "alder" "willow" "fir" "palm" "cherry" "chestnut" "teak" "pine" "ash" "peach" "maple" "pear" "sycamore" "cedar" "redwood" ))

(define (get-description printer-name)
  (process-output->string
    (list LDAPTHING "cn" printer-name "description")
    :on-abnormal-exit :ignore))

(define (add-printer printer-name)
  (html:div
    (html:h1 (get-description printer-name))
    (guard (e (else (html:p printer-name ": snmpwalk failed")))
      (call-with-input-process 
        (list SNMPWALK "-Os" "-c" "public" "-v" "2c" printer-name)
        (lambda (ip) (snmp-query-handler printer-name ip))
        :error "/dev/null")) ))

(define (snmp-query printers html-tree)
  (if (null? printers) html-tree
    (snmp-query (cdr printers) (cons (add-printer (first printers)) html-tree)) ))

(define (interesting-oid? snmp-fields oid)
  (if (null? snmp-fields)
    #f
    (if (string-prefix? (first (first snmp-fields)) oid)
      (second (first snmp-fields))
      (interesting-oid? (cdr snmp-fields) oid) ) ))

(define (good-type? type)
  (or (string=? type "STRING:") (string=? type "INTEGER:")))

(define (good-data? fields)
  (and (> (length fields) 3) (good-type? (third fields))))

(define (clean-data fields)
  (string-delete (string-join (cdddr fields) " ") #\"))

(define (get-name-and-data snmp-port line)
  (if (eof-object? line)
    #f
    (let ((fields (string-tokenize line)))
      (let ((field-name (interesting-oid? snmp-fields (first fields))))
        (if (and field-name (good-data? fields))
          (list field-name (clean-data fields))
          (get-name-and-data snmp-port (read-line snmp-port)) ) ) ) ))

(define (get-snmp-data snmp-data snmp-port)
  (let ((od (get-name-and-data snmp-port (read-line snmp-port))))
    (if od (get-snmp-data (cons od snmp-data) snmp-port) snmp-data) ) )

(define (snmp-query-handler printer-name snmp-port)
  (let ((snmp-data (get-snmp-data '() snmp-port)))
    (if (null? snmp-data)
      (html:p "SNMP query failed.")
      (apply html:table
        (html:tr (html:td "Hostname") (html:td printer-name))
        (map
          (lambda (e) (html:tr (html:td (first e)) (html:td (second e))))
          snmp-data ) ) ) ))

(define (main args)
  (write-tree
    (html:html
      (html:head (html:title "Network Connected Printers"))
      (apply html:body
        (html:p (date->string (current-date)))
        (snmp-query printer-list '())))))