maps/bin/mapsutil.pl

   1 #!/usr/bin/perl
   2 ################################################################################
   3 # File:         $RCSfile: mapsutil,v $
   4 # Revision:     $Revision: 1.1 $
   5 # Description:  This script implements a small command interpreter to exercise
   6 #               MAPS functions.
   7 # Author:       Andrew@DeFaria.com
   8 # Created:      Fri Nov 29 14:17:21  2002
   9 # Modified:     $Date: 2013/06/12 14:05:47 $
  10 # Language:     perl
  11 #
  12 # (c) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved.
  13 #
  14 ################################################################################
  15 use strict;
  16 use warnings;
  17
  18 use 5.030;
  19
  20 # For use of the given/when (See https://perlmaven.com/switch-case-statement-in-perl5)
  21 no warnings 'experimental';
  22
  23 use FindBin;
  24
  25 use Term::ReadKey;
  26
  27 use lib "$FindBin::Bin/../lib";
  28 use lib "$FindBin::Bin/../../lib";
  29
  30 use MAPS;
  31 use MAPSLog;
  32 use MyDB;
  33
  34 use CmdLine;
  35 use Utils;
  36
  37 my %cmds = (
  38   adduser => {
  39     help        => 'Add a user to MAPS',
  40     description => 'Usage: adduser <userid> <name> <email> <password>',
  41   },
  42   add2whitelist => {
  43     help        => 'Add sender to whitelist',
  44     description => 'Usage: add2whitelist <sender> <retention>',
  45   },
  46   cleanlog => {
  47     help        => 'Cleans out old log entries',
  48     description => 'Usage; cleanlog [timestamp]'
  49   },
  50   log => {
  51     help        => 'Logs a message',
  52     description => 'Usage: log <message>',
  53   },
  54   loadlist => {
  55     help        => 'Load a list file',
  56     description => 'Usage: loadlist <listfile>',
  57   },
  58   cleanemail => {
  59     help        => 'Cleans out old email entries',
  60     description => 'Usage: cleanemail [timestamp]',
  61   },
  62   deliver => {
  63     help        => 'Delivers a message',
  64     description => 'Usage: deliver <message>',
  65   },
  66   loademail => {
  67     help        => 'Load an mbox file',
  68     description => 'Usage: loademail <mbox>',
  69   },
  70   dumpemail => {
  71     help        => 'Dump email from DB to mbox file',
  72     description => 'Usage: ',
  73   },
  74   decrypt => {
  75     help        => 'Decrypt a password',
  76     description => 'Usage: decrypt <password>',
  77   },
  78   switchuser => {
  79     help        => 'Switch to user',
  80     description => 'Usage: switchuser <userid>',
  81   },
  82   setpassword => {
  83     help        => "Set a user's password",
  84     description => 'Usage: setpassword',
  85   },
  86   showuser => {
  87     help        => 'Show current user',
  88     description => 'Usage: showuser',
  89   },
  90   showusers => {
  91     help        => 'Shows users in the DB',
  92     description => 'Usage: showusers',
  93   },
  94   showemail => {
  95     help        => 'Displays email',
  96     description => 'Usage: showemail',
  97   },
  98   showlog => {
  99     help        => 'Displays <nbr> log entires',
 100     description => 'Usage: showlog <nbr>',
 101   },
 102   space => {
 103     help        => 'Display space usage',
 104     description => 'Usage: space',
 105   },
 106   showlist => {
 107     help        => 'Show list by <type>',
 108     description => 'Usage: showlist <type>',
 109   },
 110   encrypt => {
 111     help        => 'Encrypt a password',
 112     description => 'Usage: encrypt <password>',
 113   },
 114   resequence => {
 115     help        => 'Resequences a <list>',
 116     description => 'Usage: resequence <list>',
 117   },
 118 );
 119
 120 my $userid = GetContext;
 121
 122 sub EncryptPassword($$) {
 123   my ($password, $userid) = @_;
 124
 125   my $encrypted_password = Encrypt $password, $userid;
 126
 127   say "Encrypted password: '$encrypted_password'";
 128
 129   return;
 130 } # EncryptPassword
 131
 132 sub DecryptPassword($$) {
 133   my ($password, $userid) = @_;
 134
 135   my $decrypted_password = Decrypt($password, $userid);
 136
 137   say "Decrypted password: $decrypted_password";
 138
 139   return;
 140 } # DecryptPassword
 141
 142 sub Resequence($$) {
 143   my ($userid, $type) = @_;
 144
 145   ResequenceList(
 146     userid => $userid,
 147     type   => $type,
 148   );
 149 } # Resequence
 150
 151 sub Login2MAPS($;$) {
 152   my ($username, $password) = @_;
 153
 154   if ($username ne '') {
 155     $password = GetPassword unless $password;
 156   } # if
 157
 158   while (Login($username, $password) != 0) {
 159     say "Login failed!";
 160
 161     print "Username:";
 162
 163     $username = <>;
 164
 165     if ($username eq '') {
 166       say "Login aborted!";
 167
 168       return undef;
 169     } # if
 170
 171     chomp $username;
 172
 173     $password = GetPassword;
 174   } # if
 175
 176   return $username;
 177 } # Login2MAPS
 178
 179 sub LoadListFile($) {
 180   # This function loads a ".list" file. This is to "import" our old ".list"
 181   # files. Note it assumes that the ".list" files have specific names.
 182   my ($listfilename) = @_;
 183
 184   my $listtype;
 185
 186   if ($listfilename eq "white.list") {
 187     $listtype = "white";
 188   } elsif ($listfilename eq "black.list") {
 189     $listtype = "black";
 190   } elsif ($listfilename eq "null.list") {
 191     $listtype = "null";
 192   } else {
 193     say "Unknown list file: $listfilename";
 194     return;
 195   } # if
 196
 197   my $listfile;
 198
 199   if (!open $listfile, '<', $listfilename) {
 200     say "Unable to open $listfilename";
 201     return;
 202   } # if
 203
 204   my $sequence = 0;
 205
 206   Info("Adding $listfilename to $listtype list");
 207
 208   while ($listfile) {
 209     chomp;
 210     next if m/^#/ || m/^$/;
 211
 212     my ($pattern, $comment) = split /\,/;
 213
 214     AddList($listtype, $pattern, 0, $comment);
 215     $sequence++;
 216   } # while
 217
 218   if ($sequence == 0) {
 219     say "No messages found to load";
 220   } elsif ($sequence == 1) {
 221     say "Loaded 1 message ";
 222   } else {
 223     say "Loaded $sequence messages";
 224   } # if
 225
 226   say "from $listfilename";
 227
 228   close $listfile;
 229 } # LoadListFile
 230
 231 sub LoadEmail($) {
 232   # This function loads an mbox file.
 233   my ($filename) = @_;
 234
 235   my $file;
 236
 237   open $file, '<', $filename
 238     or die "Unable to open \"$filename\" - $!\n";
 239
 240   binmode $file;
 241
 242   my $nbr_msgs;
 243
 244   while (!eof $file) {
 245     my ($sender, $reply_to, $subject, $data) = ReadMsg (*$file);
 246
 247     $nbr_msgs++;
 248
 249     AddEmail(
 250       userid  => $userid,
 251       sender  => $sender,
 252       subject => $subject,
 253       data    => $data,
 254     );
 255
 256     Info("Added message from $sender to email");
 257   } # while
 258
 259   if ($nbr_msgs == 0) {
 260     say "No messages found to load";
 261   } elsif ($nbr_msgs == 1) {
 262     say "Loaded 1 message";
 263   } else {
 264     say "Loaded $nbr_msgs messages";
 265   } # if
 266
 267   say "from $file";
 268 } # LoadEmail
 269
 270 sub DumpEmail($) {
 271   # This function unloads email to a mbox file.
 272   my ($filename) = @_;
 273
 274   my $file;
 275
 276   open $file, '>', $filename or
 277     die "Unable to open \"$filename\" - $!\n";
 278
 279   binmode $file;
 280
 281   my $i = 0;
 282
 283   my ($err, $msg) = $MAPS::db->find(
 284     'email',
 285     "userid = '$userid'",
 286     qw(data),
 287   );
 288
 289   croak $msg if $msg;
 290
 291   while (my $rec = $MAPS::db->getnext) {
 292     say $file $rec->{data};
 293     $i++;
 294   } # while
 295
 296   say "$i messages dumped to $file";
 297
 298   close $file;
 299 } # DumpEmail
 300
 301 sub SwitchUser($) {
 302   my ($new_user) = @_;
 303
 304   if ($new_user = Login2MAPS($new_user)) {
 305     say "You are now logged in as $new_user";
 306   } # if
 307 } # SwitchContext
 308
 309 sub SetPassword() {
 310   FindUser(userid => $userid);
 311
 312   my $rec = GetUser;
 313
 314   return unless $rec;
 315
 316   my $password = GetPassword('Enter new password');
 317   my $repeat   = GetPassword('Enter new password again');
 318
 319   if ($password ne $repeat) {
 320     say "Passwords don't match!";
 321   } else {
 322     $rec->{password} = Encrypt($password, $userid);
 323
 324     UpdateUser(%$rec);
 325
 326     say "Password updated";
 327   } # if
 328
 329   return;
 330 } # SetPassword
 331
 332 sub ShowSpace() {
 333   my $userid = GetContext;
 334
 335   my $total_space = Space($userid);
 336
 337   $total_space = $total_space / (1024 * 1024);
 338
 339   format TOTALSIZE=
 340 Total size @###.### Meg
 341 $total_space
 342 .
 343 $~ = "TOTALSIZE";
 344
 345   write();
 346 } # ShowSpace
 347
 348 sub ShowUser() {
 349   say "Current userid is " . GetContext();
 350 } # ShowContext
 351
 352 sub ShowUsers() {
 353   FindUser(
 354     fields => ['userid', 'name', 'email'],
 355   );
 356
 357   my $rec;
 358
 359   format USERLIST =
 360 User ID: @<<<<<<<<< Name: @<<<<<<<<<<<<<<<<<<< Email: @<<<<<<<<<<<<<<<<<<<<<<<
 361 $rec->{userid},$rec->{name},$rec->{email}
 362 .
 363 $~ = "USERLIST";
 364   while ($rec = GetUser) {
 365     last unless $rec->{userid};
 366     write;
 367   } # while
 368 } # ShowUsers
 369
 370 sub ShowEmail() {
 371   my ($err, $msg) = $MAPS::db->find(
 372     'email',
 373     "userid='$userid'",
 374     qw(userid timestamp sender subject),
 375   );
 376
 377 my ($timestamp, $sender, $subject);
 378
 379 format EMAIL =
 380 @<<<<<<<<<<<<<<<<<<<@<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 381 $timestamp,$sender,$subject
 382 .
 383
 384 $~ = "EMAIL";
 385   while (my $rec = $MAPS::db->getnext) {
 386     last unless $rec->{userid};
 387
 388    $timestamp = $rec->{timestamp};
 389    $sender    = $rec->{sender};
 390    $subject   = $rec->{subject};
 391
 392     write();
 393   } # while
 394 } # ShowEmail
 395
 396 sub ShowLog($) {
 397   my ($how_many) = @_;
 398
 399   $how_many = defined $how_many ? $how_many : -20;
 400
 401   my $handle = FindLog($how_many);
 402
 403   my ($userid, $timestamp, $sender, $type, $message);
 404
 405 format LOG =
 406 @<<<<<<<<<<<<<<<<<<<@<<<<<<<<< @<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 407 $timestamp,$type,$sender,$message
 408 .
 409 $~ = "LOG";
 410
 411   my $count = 0;
 412
 413   while (my $rec = GetLog) {
 414     $timestamp = $rec->{timestamp} || '';
 415     $type      = $rec->{type}      || '';
 416     $sender    = $rec->{sender}    || '';
 417     $message   = $rec->{message}   || '';
 418
 419     $count++;
 420
 421     last if $count > $how_many;
 422
 423     write;
 424   } # while
 425
 426   return;
 427 } # ShowLog
 428
 429 sub ShowList($) {
 430   my ($type) = @_;
 431
 432   my $lines = 10;
 433   my $next  = 0;
 434   my @list;
 435   my %record;
 436
 437 format LIST =
 438 @>> @<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<
 439 $record{sequence},$record{pattern},$record{domain},$record{comment}
 440 .
 441 $~ = "LIST";
 442
 443   # TODO: Why does ReturnList return a one entry array with a many entry array
 444   # of hashes. Seems it should just return $list[0], right?
 445   while (@list = ReturnList(
 446     userid   => $userid,
 447     type     => $type,
 448     start_at => $next,
 449     lines    => $lines)) {
 450     for (@{$list[0]}) {
 451       %record = %$_;
 452
 453       # Format blows up if any field is undefined so...
 454       $record{pattern} //= '';
 455       $record{domain}  //= '';
 456       $record{comment} //= '';
 457       write();
 458     } # for
 459
 460     print 'Hit any key to continue - q to quit';
 461
 462     ReadMode 'raw';
 463     my $key = ReadKey(0);
 464     ReadMode 'normal';
 465
 466     if ($key eq 'q' or ord $key == 67) {
 467       print "\n";
 468
 469       last;
 470     } # if
 471
 472     print "\r";
 473
 474     $next += $lines;
 475   } # while
 476
 477   return;
 478 } # ShowList
 479
 480 sub ShowStats($) {
 481   my ($nbr_days) = @_;
 482
 483   $nbr_days ||= 1;
 484
 485   my %dates = GetStats(
 486     userid => $userid,
 487     days   => $nbr_days,
 488   );
 489
 490   for my $date (keys(%dates)) {
 491     for (keys(%{$dates{$date}})) {
 492       say "$date $_:";
 493       say "\t$dates{$date}{$_}";
 494     } # for
 495   } # for
 496 } # ShowStats
 497
 498 sub Deliver($) {
 499   my ($filename) = @_;
 500
 501   my $message;
 502
 503   if (!open $message, '<', $filename) {
 504     say "Unable to open message file $filename";
 505     return;
 506   } # if
 507
 508   my $data;
 509
 510   while ($message) {
 511     $data = $data . $_;
 512   } # while
 513
 514   Whitelist "Andrew\@DeFaria.com", $data;
 515
 516   close $message;
 517
 518   return;
 519 } # Deliver
 520
 521 sub ExecuteCmd($){
 522   my ($line) = @_;
 523
 524   my ($cmd, $parm1, $parm2, $parm3, $parm4) = split /\s+/, $line;
 525
 526   given ($cmd) {
 527     when (!$_) {
 528       return;
 529     } # when
 530
 531     when (/^\s*resequence\s*$/) {
 532       Resequence(GetContext(), $parm1);
 533     } # when
 534
 535     when (/^s*encrypt\s*$/) {
 536       EncryptPassword($parm1, $userid);
 537     } # when
 538
 539     when (/^\s*encrypt\s*$/) {
 540       EncryptPassword($parm1, $userid);
 541     } # when
 542
 543     when (/^\s*decrypt\s*$/) {
 544       DecryptPassword($parm1, $userid);
 545     } # when
 546
 547     when (/^\s*deliver\s*$/) {
 548       Deliver($parm1);
 549     } # when
 550
 551     when (/^\s*add2whitelist\s*$/) {
 552       if ($parm2) {
 553         $parm2 .= ' ' . $parm3
 554       } # if
 555
 556       Add2Whitelist(
 557         userid    => GetContext,
 558         type      => 'white',
 559         sender    => $parm1,
 560         retention => $parm2,
 561       );
 562     } # when
 563
 564     when (/^\s*showusers\s*$/) {
 565       ShowUsers;
 566     } # when
 567
 568     when (/^\s*adduser\s*$/) {
 569       AddUser(
 570         userid   => $parm1,
 571         name     => $parm2,
 572         email    => $parm3,
 573         password => Encrypt($parm4, $userid),
 574       );
 575     } # when
 576
 577     when (/^\s*cleanemail\s*$/) {
 578       $parm1 = "9999-12-31 23:59:59" unless $parm1;
 579
 580       say CleanEmail($parm1);
 581     } # when
 582
 583     when (/^\s*cleanlog\s*$/) {
 584       $parm1 = "9999-12-31 23:59:59" unless $parm1;
 585
 586       say CleanLog($parm1);
 587     } # when
 588
 589     when (/^\s*loadlist\s*$/) {
 590       LoadListFile($parm1);
 591     } # when
 592
 593     when (/^\s*loademail\s*$/) {
 594       LoadEmail($parm1);
 595     } # when
 596
 597     when (/^\s*dumpemail\s*$/) {
 598       DumpEmail($parm1);
 599     } # when
 600
 601     when (/^\s*log\s*$/) {
 602       Logmsg(
 603         userid  => $userid,
 604         type    => $parm1,
 605         sender  => $parm2,
 606         message => $parm3,
 607       );
 608     } # when
 609
 610     when (/^\s*switchuser\s*$/) {
 611       SwitchUser($parm1);
 612     } # when
 613
 614     when (/^\s*showuser\s*$/) {
 615       ShowUser;
 616     } # when
 617
 618     when (/^\s*showemail\s*$/) {
 619       ShowEmail;
 620     } # when
 621
 622     when (/^\s*showlog\s*$/) {
 623       ShowLog($parm1);
 624     } # when
 625
 626     when (/^\s*showlist\s*$/) {
 627       ShowList($parm1);
 628     } # when
 629
 630     when (/^\s*space\s*$/) {
 631       ShowSpace;
 632     } # when
 633
 634     when (/^\s*showstats\s*$/) {
 635       ShowStats($parm1);
 636     } # when
 637
 638     when (/^\s*setpassword\s*$/) {
 639       SetPassword;
 640     } # when
 641
 642     default {
 643       say "Unknown command: $_";
 644
 645       say "Parm1: $parm1" if $parm1;
 646       say "Parm2: $parm2" if $parm2;
 647       say "Parm3: $parm3" if $parm3;
 648       say "Parm4: $parm4" if $parm4;
 649     } # default
 650   } # given
 651
 652   return;
 653 } # ExecuteCmd
 654
 655 my $username = Login2MAPS($userid, $ENV{MAPS_PASSWORD});
 656
 657 if ($ARGV[0]) {
 658   ExecuteCmd join ' ', @ARGV;
 659   exit;
 660 } # if
 661
 662 # Use CommandLine
 663 $CmdLine::cmdline->set_cmds(%cmds);
 664 $CmdLine::cmdline->set_eval(\&ExecuteCmd);
 665
 666 while (my ($line, $result) = $CmdLine::cmdline->get) {
 667   next unless $line;
 668
 669   last if $line =~ /^\s*exit\s*$/i or $line =~ /^\s*quit\s*$/i;
 670
 671   ExecuteCmd $line;
 672 } # while
 673
 674 exit;