1 #!/usr/bin/perl -w
2 #
3 # Parse squid log and write current traffic usage by users into cache
4 #
5 # Igor Muratov <migor@altlinux.org>
6 #
7 # $Id: goQuota.pl,v 1.4 2005/04/03 00:46:14 migor-guest Exp $
8 #
10 use strict;
11 use Time::Local;
12 use Net::LDAP;
13 use DB_File;
14 use POSIX qw(strftime);
16 my $debug = 0;
17 $|=1;
19 my $LDAP;
20 my $LDAP_HOST = "localhost";
21 my $LDAP_PORT = "389";
22 my $LDAP_BASE = "ou=People,dc=example,dc=com";
24 my $ACCESS_LOG = '/var/log/squid/access.log';
25 my $CACHE_FILE = '/var/spool/squid/quota.db';
26 my $DEFAULT_PERIOD = 'm';
27 my $FORMAT = "A16 A5 S S L A5 L L L";
29 my %cache;
30 my @lines;
32 sub timestamp
33 {
34 return strftime("%a %b %X goQuota[$$]: ", localtime);
35 }
37 sub anonBind
38 {
39 my $ldap = Net::LDAP->new( $LDAP_HOST, port => $LDAP_PORT );
40 if($ldap)
41 {
42 my $mesg = $ldap->bind();
43 $mesg->code && warn timestamp, "Can't bind to ldap://$LDAP_HOST:$LDAP_PORT:", $mesg->error, "\n";
44 return $ldap;
45 }
46 else
47 {
48 warn timestamp, "Can't connect to ldap://$LDAP_HOST:$LDAP_PORT\n";
49 return undef;
50 }
51 }
53 # Retrive users's data from LDAP
54 sub update_userinfo
55 {
56 my $user = shift;
57 my $uid = $user->{uid};
59 return undef unless $LDAP;
61 # User unknown or cache field is expired
62 my $result = $LDAP->search( base=>$LDAP_BASE,
63 filter=>"(&(objectClass=gosaProxyAccount)(uid=$uid))",
64 attrs=>[
65 'uid',
66 'gosaProxyAcctFlags',
67 'gosaProxyQuota',
68 'gosaProxyQuotaPeriod',
69 'gosaProxyWorkingStop',
70 'gosaProxyWorkingStart',
71 'modifyTimestamp'
72 ]
73 );
74 $result->code && warn timestamp, "Failed to search: ", $result->error;
76 # Get user's data
77 if($result->count)
78 {
79 my $entry = ($result->entries)[0];
81 $user->{uid} = ($entry->get_value('uid'))[0];
82 $user->{modifyTimestamp} = ($entry->get_value('modifyTimestamp'))[0];
83 $user->{gosaProxyWorkingStart} = ($entry->get_value('gosaProxyWorkingStart'))[0];
84 $user->{gosaProxyWorkingStop} = ($entry->get_value('gosaProxyWorkingStop'))[0];
85 $user->{gosaProxyAcctFlags} = ($entry->get_value('gosaProxyAcctFlags'))[0];
87 my ($quota, $unit) = ($entry->get_value('gosaProxyQuota'))[0] =~ /(\d+)(\S)/g;
88 $user->{gosaProxyQuota} = $quota;
89 $user->{gosaProxyQuota} *= 1024 if $unit =~ /[Kk]/;
90 $user->{gosaProxyQuota} *= 1048576 if $unit =~ /[Mm]/;
91 $user->{gosaProxyQuota} *= 1073741824 if $unit =~ /[Gg]/;
93 $user->{gosaProxyQuotaPeriod} = ($entry->get_value('gosaProxyQuotaPeriod'))[0] || $DEFAULT_PERIOD;
94 # Return
95 warn timestamp, "User $uid found in LDAP.\n";
96 return 1;
97 } else {
98 # Unknown user
99 warn timestamp, "User $uid does not exists in LDAP.\n";
100 $user->{uid} = $uid;
101 $user->{gosaProxyAcctFlags} = '[FTB]';
102 $user->{gosaProxyQuota} = 0;
103 $user->{gosaProxyQuotaPeriod} = 'y';
104 return 0;
105 }
106 }
108 sub get_update
109 {
110 my $ts = shift;
111 my %update;
112 my $result = $LDAP->search( base=>$LDAP_BASE,
113 filter=>"(&(objectClass=gosaProxyAccount)(modifyTimestamp>=$ts))",
114 attrs=>'uid'
115 );
117 # Get user's data
118 if($result->count)
119 {
120 my $entry = ($result->entries)[0];
121 $update{($entry->get_value('uid'))[0]}++;
122 }
123 return %update;
124 }
126 # Check quota
127 sub update_quota
128 {
129 my $user = shift;
130 my $uid = $user->{uid};
132 my $period = 0;
133 $period = 3600 if $user->{gosaProxyQuotaPeriod} eq 'h';
134 $period = 86400 if $user->{gosaProxyQuotaPeriod} eq 'd';
135 $period = 604800 if $user->{gosaProxyQuotaPeriod} eq 'w';
136 $period = 2592000 if $user->{gosaProxyQuotaPeriod} eq 'm';
137 $period = 220752000 if $user->{gosaProxyQuotaPeriod} eq 'y';
139 if($user->{lastRequest} - $user->{firstRequest} > $period)
140 {
141 if($user->{trafficUsage} > $user->{gosaProxyQuota})
142 {
143 warn timestamp, "Reduce quota for $uid while $period seconds.\n";
144 $user->{trafficUsage} -= $user->{gosaProxyQuota};
145 $user->{firstRequest} += $period;
146 }
147 else
148 {
149 warn timestamp, "Restart quota for $uid.\n";
150 $user->{trafficUsage} = 0;
151 $user->{firstRequest} = $user->{lastRequest};
152 }
153 }
154 }
156 sub dump_data
157 {
158 my $user = shift;
159 print "User: ",$user->{uid},"\n";
160 print "\t",$user->{modifyTimestamp},"\n";
161 print "\t",$user->{gosaProxyAcctFlags},"\n";
162 print "\t",$user->{gosaProxyWorkingStart},"\n";
163 print "\t",$user->{gosaProxyWorkingStop},"\n";
164 print "\t",$user->{gosaProxyQuota},"\n";
165 print "\t",$user->{gosaProxyQuotaPeriod},"\n";
166 print "\t",$user->{trafficUsage},"\n";
167 print "\t",$user->{firstRequest},"\n";
168 print "\t",$user->{lastRequest},"\n";
169 }
171 sub unpack_user
172 {
173 my $uid = shift;
174 my $user;
176 $user->{uid} = $uid;
177 (
178 $user->{modifyTimestamp},
179 $user->{gosaProxyAcctFlags},
180 $user->{gosaProxyWorkingStart},
181 $user->{gosaProxyWorkingStop},
182 $user->{gosaProxyQuota},
183 $user->{gosaProxyQuotaPeriod},
184 $user->{trafficUsage},
185 $user->{firstRequest},
186 $user->{lastRequest}
187 ) = unpack($FORMAT, $cache{$uid});
189 return $user;
190 }
192 sub pack_user
193 {
194 my $user = shift;
196 $cache{$user->{uid}} = pack(
197 $FORMAT,
198 $user->{modifyTimestamp},
199 $user->{gosaProxyAcctFlags},
200 $user->{gosaProxyWorkingStart},
201 $user->{gosaProxyWorkingStop},
202 $user->{gosaProxyQuota},
203 $user->{gosaProxyQuotaPeriod},
204 $user->{trafficUsage},
205 $user->{firstRequest},
206 $user->{lastRequest}
207 );
208 }
210 #--------------------------------------
211 $LDAP = anonBind or die timestamp, "No lines processed.\n";
213 # This is a first time parsing?
214 my $firstStart = 1;
215 $firstStart = 0 if -e $CACHE_FILE;
217 # Open log file and cache
218 my $cache = tie(%cache, 'DB_File', $CACHE_FILE, O_CREAT|O_RDWR);
219 my $log = tie(@lines, 'DB_File', $ACCESS_LOG, O_RDWR, 0640, $DB_RECNO)
220 or die "Cannot open file $ACCESS_LOG: $!\n";
222 # Mark users which updated in LDAP
223 my %updated;
224 if(! $firstStart)
225 {
226 my $ts = strftime("%Y%m%d%H%M%SZ", gmtime);
227 %updated = get_update($cache{MODIFY_TIMESTAMP} || "19700101000000Z");
229 my @count = %updated;
230 $cache{MODIFY_TIMESTAMP} = $ts if $#count;
232 foreach my $u (keys %updated)
233 {
234 warn timestamp, "User $u has been updated in LDAP. Refresh data.\n";
235 my $user = unpack_user($u);
236 update_userinfo($user);
237 pack_user($user);
238 }
239 }
241 # Processing log file
242 my $index = $cache{TIMESTAMP} < (split / +/, $lines[0])[0]
243 ? 0 : $cache{STRING_NUMBER};
244 warn timestamp, "Cache update start at line $index.\n";
245 while($lines[$index])
246 {
247 # There are array named lines with elements
248 # 0 - line timestamp
249 # 1 - ?? (unused)
250 # 2 - client's IP (unused)
251 # 3 - squid's cache status TEXT_CODE/num_code (unused)
252 # 4 - object size in bytes
253 # 5 - metod (unused)
254 # 6 - URL (unused)
255 # 7 - username
256 # 8 - load status TYPE/source
257 # 9 - mime type (unused)
258 my @line = split / +/, $lines[$index++];
260 # Skip line if have no incoming traffic
261 (my $errcode = $line[8]) =~ s/\/\S+//;
262 next if $errcode eq "NONE";
264 # Get data from cache
265 (my $uid = $line[7]) =~ s/^-$/anonymous/;
266 my $user = unpack_user($uid);
268 # Update user info from LDAP if need
269 if ( !exists($cache{$uid}) )
270 {
271 warn timestamp, "User $uid is not in cache. Go to search LDAP.\n";
272 update_userinfo($user);
273 }
275 # Update traffic info
276 $user->{trafficUsage} += $line[4];
277 $user->{firstRequest} |= $line[0];
278 $user->{lastRequest} = $line[0];
280 update_quota($user);
281 pack_user($user);
283 dump_data($user) if $debug;
285 $cache{TIMESTAMP} = $user->{lastRequest};
286 }
288 warn timestamp, $index - $cache{STRING_NUMBER}, " new lines processed.\n";
289 $cache{STRING_NUMBER} = $index;
291 $LDAP->unbind;
292 untie @lines;
293 untie %cache;