src/modules/rlm_counter/rad_counter.pl

   1 #!/usr/bin/perl
   2 #
   3 #       $Id$
   4 #
   5 use warnings ;
   6 use GDBM_File ;
   7 use Fcntl ;
   8 use Getopt::Long;
   9
  10 my $user = '';
  11 my $divisor = 1;
  12 my $reset = 0;
  13 my $match = '.*';
  14 my $help = 0;
  15
  16 #
  17 #  This should be fixed...
  18 #
  19 $filename = '';
  20
  21 sub show_help {
  22     print "Usage: $0 --file=<counter filename> [--reset=<seconds>] [--match=<regexp>]\n";
  23     print "[--user=<username>] [--help] [--hours|--minutes|--seconds]\n\n";
  24     print "--user=<username>", "\t\t", "Information for specific user\n";
  25     print "--file=<filename>", "\t\t", "Counter db filename\n";
  26     print "--match=<regexp>", "\t\t", "Information for matching users\n";
  27     print "--reset=<number>", "\t\t", "Reset counter to <number>.\n";
  28     print "\t\t\t\t", "If divisor is set use it, else <number> means seconds\n";
  29     print "--help", "\t\t\t\t", "Show this help screen\n";
  30     print "--(hours|minutes|seconds)", "\t", "Specify information divisor\n";
  31     exit 0;
  32 }
  33
  34 #
  35 #  Print out only one user,
  36 #
  37 #  Or specifiy printing in hours, minutes, or seconds (default)
  38 #
  39 GetOptions ('user=s'  => \$user,
  40             'match=s' => \$match,
  41             'file=s'  => \$filename,
  42             'reset=i' => \$reset,
  43             'help'    => \$help,
  44             'hours'   => sub { $divisor = 3600 },
  45             'minutes' => sub { $divisor = 60 },
  46             'seconds' => sub { $divisor = 1 } );
  47
  48 show_help if ($help || $filename eq '');
  49
  50 #
  51 #  Open the file.
  52 #
  53 if ($reset){
  54     my $db = tie(%hash, 'GDBM_File', $filename, O_RDWR, 0666) or die "Cannot open $filename: $!\n";
  55 }else{
  56     my $db = tie(%hash, 'GDBM_File', $filename, O_RDONLY, 0666) or die "Cannot open $filename: $!\n";
  57 }
  58
  59 #
  60 #  If given one name, give the seconds
  61 #
  62 if ($user ne '') {
  63     if (defined($hash{$user})){
  64         print $user, "\t\t", int ( unpack('L',$hash{$user}) / $divisor), "\n";
  65         if ($reset){
  66             my $uniqueid = (unpack('L A32',$hash{$user}))[1];
  67             $hash{$user} = pack('L A32',$reset * $divisor,$uniqueid);
  68             print $user, "\t\t", "Counter reset to ", $reset * $divisor, "\n";
  69         }
  70     }else{
  71         print $user, "\t\t", "Not found\n";
  72     }
  73
  74     undef $db;
  75     untie %hash;
  76     exit 0;
  77 }
  78
  79 #
  80 #  This may be faster, but unordered.
  81 #while (($key,$val) = each %hash) {
  82 #
  83 foreach $key (sort keys %hash) {
  84     #
  85     #  These are special.
  86     next if ($key eq "DEFAULT1");
  87     next if ($key eq "DEFAULT2");
  88
  89     #
  90     #  Allow user names matching a regex.
  91     #
  92     next if ($key !~ /$match/);
  93
  94     #
  95     #  Print out the names...
  96     print $key, "\t\t", int ( unpack('L',$hash{$key}) / $divisor), "\n";
  97     if ($reset){
  98         my $uniqueid = (unpack('L A32',$hash{$key}))[1];
  99         $hash{$key} = pack('L A32',$reset * $divisor,$uniqueid);
 100         print $key, "\t\t", "Counter reset to ", $reset * $divisor, "\n";
 101     }
 102 }
 103 undef $db;
 104 untie %hash;