1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;; Copyright 2009, NORDUnet A/S.
;;
;; This file is part of Eduroam-stats.
;;
;; Eduroam-stats 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 2 of the License, or
;; (at your option) any later version.
;;
;; Eduroam-stats 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 Eduroam-stats. If not, see <http://www.gnu.org/licenses/>.
(in-package :bgp-logger)
(defparameter *debug* nil)
(defun next-xml-blurb (reader tag)
"Return the next XML document in a stream that is enclosed in a given XML tag.
READER is a function taking one argument -- the number of bytes to
read -- and returns that many octets or nil on read error or end of
stream.
TAG is a string.
BUGS:
- Case sensitive matching of tag.
- Opening tag must contain attributes (or at least a space after the tag).
"
(let ((start-tag (format nil "<~A " tag))
(end-tag (format nil "</~A>" tag))
(storing-p nil)
(match-count 0)
(acc (make-array 2048 :fill-pointer 0 :adjustable t)))
(when *debug* (format t "start-tag ~A~%, end-tag ~A~%" start-tag end-tag))
(do ((c (funcall reader 1) (funcall reader 1)))
((or (null c) (and storing-p (= match-count (length end-tag))))
(if (null c) nil acc))
(when *debug* (format t "looking at ~A~%" c))
(vector-push-extend c acc)
(if storing-p
(if (eql c (char-code (aref end-tag match-count)))
(incf match-count)
(setf match-count 0))
(if (= match-count (length start-tag))
(if (eql c (char-code #\>)) ; looking for '>'
(setf storing-p t))
(if (eql c (char-code (aref start-tag match-count))) ; looking for start-tag
(incf match-count)
(progn
(setf match-count 0)
(setf (fill-pointer acc) 0)))))))) ; discard
(let ((sock nil))
(defun new-reader (host port)
(when sock (close-reader))
(setf sock (usocket:socket-connect host
port
:element-type '(unsigned-byte 8)))
(lambda (n)
(assert (= n 1))
(read-byte (usocket:socket-stream sock) nil)))
(defun close-reader ()
(usocket:socket-close sock)))
(defun iso-date (universal-time &optional (include-seconds nil))
"Return a string denoting UNIVERSAL-TIME"
(multiple-value-bind (second minute hour day month year)
(decode-universal-time universal-time)
(if include-seconds
(format nil "~4,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D:~2,'0D"
year month day hour minute second)
(format nil "~4,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D"
year month day hour minute))))
|
