/[radius]/radius/radscm/ipalloc.scm
ViewVC logotype

Diff of /radius/radscm/ipalloc.scm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by gray, Fri Jun 13 07:27:54 2003 UTC revision 1.2 by gray, Sun Jun 15 14:16:23 2003 UTC
# Line 16  Line 16 
16  ;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  ;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
17  ;;;;  ;;;;
18    
19    ;;;; These two functions implement a "pseudo-static" IP allocation strategy.
20    ;;;; The IP pool is kept in a database table of the following structure:
21    ;;;;
22    ;;;; CREATE TABLE ippool (
23    ;;;;  # Current entry status:
24    ;;;;  status enum ('FREE', # Entry is free to use
25    ;;;;               'BLCK', # Entry is blocked and cannot be used
26    ;;;;               'FIXD', # Entry represents a fixed IP address
27    ;;;;               'ASGN', # Entry represents an IP assigned to the user
28    ;;;;               'RSRV') # Entry is reserved
29    ;;;;       default 'FREE' not null,
30    ;;;;  # Timestamp of the last update of the entry
31    ;;;;  time datetime DEFAULT '0000-00-00 00:00:00' NOT NULL,
32    ;;;;  # A user that is or recently was using this IP
33    ;;;;  user_name varchar(32) binary default '' not null,
34    ;;;;  # NAS IP address
35    ;;;;  nas char(17) default '0.0.0.0' not null
36    ;;;;  # IP address
37    ;;;;  ipaddr char(17) default '' not null)
38    ;;;;
39    ;;;;  Usage:
40    ;;;;  #raddb/hints:
41    ;;;;  DEFAULT Scheme-Acct-Procedure = "ip-alloc-update"  NULL
42    ;;;;  #raddb/users
43    ;;;;  BEGIN   Scheme-Procedure = "ip-alloc"     Fall-Through = Yes
44    
45    ;; Define this to 'postgres if you use PostgreSQL. For other DBMS you will
46    ;; have to modify the *abstime* definition below.
47    (define dbtype 'mysql)
48    (define *abstime* (case dbtype
49                        ((mysql) "unix_timestamp()")
50                        ((postgres) "abstime('now')")
51                        (else
52                         (error (string-append
53                                 (port-filename (current-input-port)) ":"
54                                 (number->string (port-line (current-input-port)))
55                                 " "
56                                 "unknown SQL interface")))))
57    
58  (define (ip-alloc req check reply)  (define (ip-alloc req check reply)
59    (let ((nas-ip (inet-ntoa (cdr (assoc "NAS-IP-Address" req))))    (let ((nas-ip (inet-ntoa (cdr (assoc "NAS-IP-Address" req))))
60          (user-name (cdr (assoc "User-Name" req))))          (user-name (cdr (assoc "User-Name" req))))
61      (radius-sql-query SQL_AUTH      (radius-sql-query SQL_AUTH
62                        (string-append                        (string-append
63                         "UPDATE ippool "                         "UPDATE ippool "
64                         "SET status='RSRV',time=unix_timestamp(),nas='"                         "SET status='RSRV',time=" *abstime* ",nas='"
65                         nas-ip                         nas-ip
66                         "' WHERE user_name='" user-name                         "' WHERE user_name='" user-name
67                         "' AND (status='FREE' OR status='RSRV')"))                         "' AND (status='FREE' OR status='RSRV')"))
# Line 31  Line 70 
70                    SQL_AUTH                    SQL_AUTH
71                    (string-append                    (string-append
72                     "SELECT ipaddr,status FROM ippool WHERE user_name='"                     "SELECT ipaddr,status FROM ippool WHERE user_name='"
73                     user-name "'"))))                     user-name "' AND status <> 'BLCK'"))))
74          (cond          (cond
75           (res           (res
76            (rad-log L_DEBUG "HIT")            (rad-log L_DEBUG "HIT")
# Line 53  Line 92 
92                     SQL_AUTH                     SQL_AUTH
93                     (string-append                     (string-append
94                      "UPDATE ippool SET user_name='" user-name                      "UPDATE ippool SET user_name='" user-name
95                      "',status='RSRV',time=unix_timestamp(),nas='"                      "',status='RSRV',time=" *abstime* ",nas='"
96                      nas-ip "' WHERE ipaddr='" (caar temp-ip)                      nas-ip "' WHERE ipaddr='" (caar temp-ip)
97                      "' AND (status='FREE' OR status='RSRV')"))                      "' AND (status='FREE' OR status='RSRV')"))
98                    (if (radius-sql-query                    (if (radius-sql-query
# Line 80  WHERE (status='RSRV' OR status='ASGN') A Line 119  WHERE (status='RSRV' OR status='ASGN') A
119         (radius-sql-query         (radius-sql-query
120          SQL_AUTH          SQL_AUTH
121          (string-append          (string-append
122           "UPDATE ippool SET time=unix_timestamp(), status='ASGN' \           "UPDATE ippool SET time=" *abstime*
123  WHERE user_name = '" user-name "' AND (status='FREE' OR status='RSRV')")))           ", status='ASGN' WHERE user_name = '"
124             user-name "' AND (status='FREE' OR status='RSRV')")))
125        ((2) ; Stop        ((2) ; Stop
126         (radius-sql-query         (radius-sql-query
127          SQL_AUTH          SQL_AUTH
128          (string-append          (string-append
129           "UPDATE ippool SET time=unix_timestamp(), status='FREE' \           "UPDATE ippool SET time=" *abstime*
130  WHERE user_name = '" user-name           ", status='FREE' WHERE user_name = '"
131          "' AND (status='ASGN' OR status='RSRV')")))))           user-name "' AND (status='ASGN' OR status='RSRV')")))))
132    #t)    #t)

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26