1 | #| |
---|
2 | Copyright (c) 2007 |
---|
3 | All rights reserved. |
---|
4 | |
---|
5 | Redistribution and use in source and binary forms, with or without |
---|
6 | modification, are permitted provided that the following conditions |
---|
7 | are met: |
---|
8 | 1. Redistributions of source code must retain the above copyright |
---|
9 | notice, this list of conditions and the following disclaimer. |
---|
10 | 2. Redistributions in binary form must reproduce the above copyright |
---|
11 | notice, this list of conditions and the following disclaimer in the |
---|
12 | documentation and/or other materials provided with the distribution. |
---|
13 | 3. The name of the author may not be used to endorse or promote products |
---|
14 | derived from this software without specific prior written permission. |
---|
15 | |
---|
16 | THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR |
---|
17 | IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES |
---|
18 | OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. |
---|
19 | IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, |
---|
20 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT |
---|
21 | NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, |
---|
22 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY |
---|
23 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT |
---|
24 | INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF |
---|
25 | THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
---|
26 | |# |
---|
27 | (in-package :nio) |
---|
28 | |
---|
29 | (declaim (optimize (debug 3) (speed 3) (space 0))) |
---|
30 | |
---|
31 | |
---|
32 | ;;concept of a remote socket with properties e.g. stats, connection attempts etc |
---|
33 | (defclass node() |
---|
34 | ((family :initform :unknown :initarg :family) |
---|
35 | (remote-host :initarg :remote-host |
---|
36 | :initform nil |
---|
37 | :accessor remote-host) |
---|
38 | (remote-port :initarg :remote-port |
---|
39 | :initform nil |
---|
40 | :accessor remote-port) |
---|
41 | (last-connect-attempt :initform nil |
---|
42 | :accessor last-connect-attempt |
---|
43 | :documentation "Time we last attempted a connection") |
---|
44 | (retry-delay :initform 60 |
---|
45 | :accessor retry-delay |
---|
46 | :documentation "The delay to wait (in secs) after the last-connection-attempt before trying to connect again (10 mins)") |
---|
47 | (active-conn :initform nil |
---|
48 | :accessor active-conn |
---|
49 | :documentation "If we are connected to this remote socket this is set to the SM"))) |
---|
50 | |
---|
51 | (defun node(host port) |
---|
52 | (make-instance 'node :remote-host host :remote-port port)) |
---|
53 | |
---|
54 | ;(node-from-socket-repn "192.168.1.1:1234") |
---|
55 | (defun node-from-socket-repn(socket) |
---|
56 | (let ((colon-idx (search ":" socket))) |
---|
57 | (if colon-idx |
---|
58 | (node (subseq socket 0 colon-idx) (parse-integer (subseq socket (+ colon-idx 1)))) |
---|
59 | (error 'parse-error)))) |
---|
60 | |
---|
61 | |
---|
62 | (defmethod print-object ((a-node node) stream) |
---|
63 | (with-slots (remote-host remote-port last-connect-attempt retry-delay active-conn) a-node |
---|
64 | (format stream "#<NODE :remote-host ~A :remote-port ~A :last-connect-attempt ~A :retry-delay ~A :active-conn ~A>" |
---|
65 | remote-host remote-port last-connect-attempt retry-delay active-conn))) |
---|
66 | |
---|
67 | |
---|
68 | (defparameter *nodes-list* nil |
---|
69 | "List of nodes to connect to") |
---|
70 | |
---|
71 | (defun load-nodes (filename) |
---|
72 | (with-open-file (stream filename) |
---|
73 | (loop for line = (read-line stream nil nil) do |
---|
74 | (push (node-from-socket-repn line) *nodes-list*)))) |
---|
75 | |
---|
76 | |
---|
77 | ;;returns floating point (high-res) next allowed connect time |
---|
78 | (defun get-next-allowed-connect-time(node) |
---|
79 | (if (null (last-connect-attempt node)) |
---|
80 | (get-universal-high-res) |
---|
81 | (+ (last-connect-attempt node) (retry-delay node)))) |
---|
82 | |
---|
83 | (defun allowed-to-connect(node) |
---|
84 | (if (null (last-connect-attempt node)) |
---|
85 | t |
---|
86 | (and (not (active-conn node)) (< (+ (last-connect-attempt node) (retry-delay node)) (get-universal-high-res))))) |
---|
87 | |
---|
88 | (defun update-last-connect-attempt(node) |
---|
89 | (setf (last-connect-attempt node) (get-universal-high-res))) |
---|
90 | |
---|
91 | ;;iterates over the nodes list looking for nodes that are ready to be connected to |
---|
92 | ;;i.e. the SM is null and the next-allowed-connect time has expired |
---|
93 | (defmacro with-connect-ready-nodes ((node) &rest body) |
---|
94 | `(dolist (,node *nodes-list*) |
---|
95 | (when (allowed-to-connect ,node) ,@body))) |
---|
96 | |
---|
97 | |
---|
98 | (defmacro with-connected-nodes ((node) &rest body) |
---|
99 | `(dolist (,node *nodes-list*) |
---|
100 | (when (active-conn ,node) ,@body))) |
---|
101 | |
---|
102 | (defun connected-nodes-count() |
---|
103 | (let ((count 0)) |
---|
104 | (with-connected-nodes (node) |
---|
105 | (incf count)) |
---|
106 | count)) |
---|
107 | |
---|