#! /usr/bin/perl
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#
# Copyright 2009, 2010: Bente Christine Aasgaard
# 		  2019: Johnny A. Solbu <johnny@solbu.net>
#
# Authors: Bente Christine Aasgaard <bca@usit.uio.no>
#          Øystein Gyland <oystein.gyland@usit.uio.no>
#          Peder Stray <peder@ifi.uio.no>
#	   Johnny A. Solbu <johnny@solbu.net>
# 
# 
# Thanks to Kjetil Torgrim Homme for great inspiration from his
# listadmin script.
# 
# TODO : Only work on specific lists
#        Moderate documents
#        Smoother viewing of complete e-mail


use strict;
use warnings;

use open OUT => ':locale';

use POSIX;
use Encode;
use I18N::Langinfo qw(langinfo CODESET);

use SOAP::Lite;
use HTTP::Cookies;
use Getopt::Long;
use Term::ReadKey;
use Term::ReadLine;
use Term::ReadLine::Gnu;
use Pod::Usage;
use Crypt::SSLeay;
use MIME::Tools;
use Text::Abbrev;

use Data::Dumper;


$Data::Dumper::Indent = $Data::Dumper::Sortkeys = 1;

my $configfile =  $ENV{"HOME"}."/.sympaadmin.ini";
my %services;
my %alllists;

my $version = "2.0";

my $debug = 0;
my $opt_help = 0;
my $opt_version = 0;

GetOptions("help|h|?+" => \$opt_help,
           "version|v|V" => \$opt_version,
           "debug|d+" => \$debug,
           "configfile|config|c|f=s" => \$configfile,
          )
  or pod2usage(2);
pod2usage(-verbose => $opt_help,
          -exitval => 1,
         ) if $opt_help;

if ($opt_version) {
    print "sympaadmin version $version\n";
    exit(0);
}

# Define :locale as an encoding for perl
Encode::define_encoding(find_encoding(langinfo(CODESET())), 'locale');

my @automod_actions = qw(discard reject approve skip);
my @mod_actions = (qw(view), @automod_actions);

my %automod_actions = abbrev @automod_actions;
my %mod_actions = abbrev @mod_actions;

my $config = readConf($configfile);

my $term = new Term::ReadLine "Sympaadmin"; 
my $feat = $term->Features;
my $attr = $term->Attribs;

open (TTY, "+<", "/dev/tty") || die "Could not open tty $!\n";
for my $serverconfig (@{$config->{soapservers}}) {
    my $server = $serverconfig->{server};
    my $username = $serverconfig->{username};
    printf "Soap server: %s\n", $server;
    my $pass = $config->{usernames}{$username}{password};
    if (defined($pass)) {
        printf "Using password previously registered for '%s'.\n", $username;
    } else {
        ReadMode('noecho', *TTY);
        printf TTY "Password for '%s': ", $username; 
        $pass = ReadLine(0, *TTY);       
        ReadMode('restore', *TTY);       
        chomp($pass);
        $config->{usernames}{$username}{password} = $pass;
        print "\n";
    }
    my $cookies = HTTP::Cookies->new(ignore_discard => 1);
    my $soap = new SOAP::Lite();    
    
    $soap->uri('urn:sympasoap');
    $soap->proxy($server, cookie_jar => $cookies);
    $cookies->load();
    
    my $response = $soap->login($username,$pass);
    $cookies->save;
    if ($response->faultcode) {
        my $detail = $response->faultdetail || "";
        printf STDERR "\nError:\t%s. \n\t%s.\n",$response->faultstring, $detail;
        printf STDERR "Skipping %s:%s.\n", $server, $username;
    } else {
        $services{servers}{$server}{$username}{cookies} = $cookies;
        $services{servers}{$server}{$username}{soap} = $soap;
        $services{servers}{$server}{$username}{md5} = $response->result;
        $services{servers}{$server}{$username}{username} = $username;
    }
    print "\n\n";
}
close(TTY);
$term->clear_history;
# TODO: Flush all passwords

# No need to move on if no logons were successful
unless (%services) {
    print STDERR "No successful logon to services. Exiting...\n";
    exit(1);
}

get_lists(\%services, \%alllists);

my %commands = (
                help => sub { pod2usage( -verbose => 99,
                                         -exitval => 'NOEXIT',
                                         -sections => 'ARGUMENTS',
                                       )},
                quit => sub { -1; },
                debug => sub { 
                    $debug = !$debug; 
                    printf "Debug is now %s\n", $debug ? 'on' : 'off';
                },
                list => {
                         all => \&cmd_list_all,
                         admin => \&cmd_list_admin,
                         members => \&cmd_list_members,
                         memberships => \&cmd_list_memberships,
                        },
                add => \&cmd_add_member,
                remove => \&cmd_remove_member,
                moderate => \&cmd_moderate,
                # subscribe => \&cmd_subscribe,
                # unsubscribe => \&cmd_unsubscribe,
               );

# Lets start a commando loop if no arguments were given
if (@ARGV) {
    # only one command as parameters
    do_command("@ARGV");
}
else {
    if (-t STDIN) {
        # STDIN is a terminal, lets use readline
        printf "Using %s\n", $term->ReadLine if $debug;

        $term->ornaments("us,ue,,") if $feat->{ornaments};
        $attr->{completion_function} = \&completion;

        while (1) {

            my $line = $term->readline("sympaadmin> ");
    
            if (defined $line) {
                my $ret = do_command($line);
                if ($ret < 0) {
                    last; # quit
                } elsif ($ret) {
                    # ok
                } else {
                    # error
                }
            } else {
                print "\n";
                last;
            }
        }
    } else {
        # STDIN is not a terminal, use dumb linebased reads
        while (<STDIN>) {
            chomp;
            do_command($_);
        }
    }
}

exit 0;

sub completion {
    my($text, $line, $start) = @_;
    # text = text of word before marker
    # line = the whole line
    # start = pos of current word in line
    
    # pick out the part before the word at cursor, and split it
    my @cmd = split " ", substr($line, 0, $start);
    
    #print "\n. Complete ($text, $line, $start) [@cmd]\n";
    #$term->on_new_line;
    
    my $hash = \%commands;
    
    while (@cmd) {
        my $cmd = shift @cmd;
        if (ref($hash) eq 'HASH') {
            # subcommand
            my %abbr = abbrev keys %$hash;
            if ($abbr{$cmd}) {
                $hash = $hash->{$abbr{$cmd}}
            }
        } else {
            # unknown command, we return an empty list;
            return;
        }
    }
    
    if (ref($hash) eq 'HASH') {
        return grep { /^\Q$text\E/ } keys %$hash;
    } else {
        return;
    }
}

sub do_command {
    my($line) = @_;
    my @cmd = split " ", $line;
    
    my $hash = \%commands;
    my @run;
    
    while (1) {
        if (ref($hash) eq 'HASH') {
            my $cmd = shift @cmd || "";
            unless ($cmd) {
                if ($cmd ne ""){
                    # We only print the error message if the command
                    # is not empty.
                    print "Incomplete command '@run'!\n";
                }
                return 0;
            }    
            my %abbr = abbrev keys %$hash;
            my $look = $abbr{$cmd} || "";
            $hash = $hash->{$look};
            printf "sub '$cmd'\n" if $debug;
            push @run, $cmd;
        } elsif (ref($hash) eq 'CODE') {
            print "run '[@run](@cmd)'\n" if $debug;
            return $hash->("@cmd");
        } else {
            print "Unknown command `@run'!\n";
            return 0;
        }
    }
}

sub readConf {
    my ($cf) = @_;
    my $config;
    my $error = 0;
    
    if (-f $cf) {
        open(CONF, "<", $cf) 
            or die "Could not open $cf : $!\n";;
        my $username;
      LINE:
        while (<CONF>) {
            chomp;
            s/\#.*//; # fjerne kommentarer fra alle linjer
            s/\s*$//;
            next if /^\s*$/;
            if (/^\s*(\S+)\s*=\s*(.*)/) {
                my ($key, $val) = ($1, $2);
                unless (length $val) {
                    warn sprintf "%s:%d: Missing value for %s\n", $cf, $., $key;
                    $error++;
                    next LINE;
                }
                if ($key eq "soapserver") {
                    if ($val =~ /\s/) {
                        warn sprintf "%s:%d: soapserver can't contain spaces: '%s'\n", $cf, $., $val;
                        $error++;
                        next LINE;
                    }
                    push(@{$config->{soapservers}},
                        { server => $val,
                            username => $username,
                        });
                } elsif ($key eq "soapuser") {
                    if ($val =~ /\s/) {
                        warn sprintf "%s:%d: soapuser can't contain spaces: '%s'\n", $cf, $., $val;
                        $error++;
                        next LINE;
                    }
                    $username = $val;
                    $config->{usernames}{$username} = {};
                } elsif ($key eq "nomoderate") {
                    if ($val =~ /\s/) {
                        warn sprintf "%s:%d: List can't contain spaces: '%s'\n", $cf, $., $val;
                        $error++;
                        next LINE;
                    }
                    $config->{nomod}{$val} = 1;
                } elsif ($key eq "addlist") {
                    if ($val =~ /\s/) {
                        warn sprintf "%s:%d: List can't contain spaces: '%s'\n", $cf, $., $val;
                        $error++;
                        next LINE;
                }
                    $config->{mod}{$val} = 1;
                } elsif ($key eq "automod") {
                    my($action,$header,$rule) = split " ", $val, 3;
                    my($a, $re);

                    if ($automod_actions{lc $action}) {
                        $a = $automod_actions{lc $action};
                    }

                    unless ($a) {
                        warn sprintf "%s:%d: Unknown automod action: '%s'\n", $cf, $., $action;
                        $error++;
                        next LINE;
                    }

                    if ($header =~ /:$/) {
                        $re = $rule;
                        for ($re) {
                            $_ = "\Q$_\E" unless /^\^/ || /\$$/ || /[.\]][*+?]|\\[rntswdSWD]/;
                            $_ = ".*$_" unless s/^\^//;
                            $_ = "$_.*" unless s/\$$//;
                        }

                        eval {
                            $re = qr/^$header\s*$re$/mi;
                        };

                    } else {
                        $re = $header;
                        $re .= " $rule" if $rule;
                        eval {
                            $re = qr/\n\n.*$re/mis;
                        };
                    }

                    if ($@) {
                        warn sprintf("%s:%d: Error in automod rule: '%s'\n\t%s\n", $cf, $., $val, $@ );
                        $error++;
                        next LINE;
                    }

                    # printf "adding %s -> %s\n", $re ,$a;

                    push @{$config->{modrules}}, [ $a, $re ];
                } else {
                    warn sprintf "%s:%d: Unknown configuration directive: '%s'\n", $cf, $., $key;
                    $error++;
                    next LINE;
                }
            } else {
                warn sprintf "%s:%d: Unparsable line: '%s'\n", $cf, $., $_;
                $error++;
                next LINE;
            }
        }
        close CONF;
        if ($error) {
            die "Configuration file contains errors\n";
        }
    } 
    else {
        printf STDERR "Error: Configfile '%s' does not exists.\n", $cf;
    }
    return $config;
}

sub cmd_list_all {
    list_lists("all");
}

sub cmd_list_admin {    
    list_lists("admin");
}

sub cmd_list_memberships {
    list_lists("memberships");
}

sub list_lists {
    my ($type) = @_;
    if ($type eq "all") {
        print "All my lists:\n\n";
    } elsif ($type eq "admin") {
        print "List I administrate:\n\n";
    } elsif ($type eq "memberships") {
        print "My memberships:\n\n";
    }
    foreach my $url (keys %{$services{servers}}) {
        for my $username (keys %{$services{servers}->{$url}}) {
            my $service = $services{servers}->{$url}{$username};
            my $lists = $service->{lists};
            printf "[%s]\n", $url;
            for my $list (@$lists) {
                next if $type eq "memberships" && !$list->{isSubscriber};
                next if $type eq "admin" && !($list->{isOwner} || $list->{isEditor});
                printf("List:\t%s \n\t[%s] \n\tAdress: %s\n\tSubject: %s\n", 
                       $list->{listAddress}, 
                       join(", ", keys %{$list->{roles}}),
                       $username,
                       $list->{subject},
                      );
            }
            print "\n\n";
        }
    }
}

sub get_lists {
    my ($services, $alllists) = @_;
    my @ret;
    foreach my $url (keys %{$services{servers}}) {
        for my $username (keys %{$services{servers}->{$url}}) {
            my $service = $services{servers}->{$url}{$username};
            my $response =
              $service->{soap}->authenticateAndRun($service->{username},
                                                   $service->{md5},
                                                   "complexWhich", 
                                                   [ ],
                                                  );
            my @res = getResult($response);
    
            for my $list (@{$response->result} ) {
                $list->{roles}{owner}++ if $list->{isOwner};
                $list->{roles}{editor}++ if $list->{isEditor};
                $list->{roles}{member}++ if $list->{isSubscriber};

                # my ($shortname,$domain) = split("@",$list->{listAddress});
                if ($list->{isOwner} || $list->{isEditor}) {
                    push @{$services{servers}{$url}{$username}{admin}},
                      $list->{listAddress};
                } 
                if ($list->{isSubscriber}) {
                    push @{$services{servers}{$url}{$username}{member}},
                      $list->{listAddress};
                }
                # "Reverse lookup"
                $alllists{alllists}{$list->{listAddress}} = 
                  {
                   url => $url,
                   username => $username,
                  };
                push @{$services{servers}{$url}{$username}{lists}}, $list;
            }
        }
    }
}

sub cmd_moderate {
    my ($arg) = @_;

    if (defined($arg)) {
        show_mods(split(" ", $arg));
    } else {
        show_mods();
    }
}



# Error: Return array always contain an undef
sub show_mods {
    my (@lists) = @_;
    foreach my $url (keys %{$services{servers}}) {
        for my $username (keys %{$services{servers}->{$url}}) {
            my $service = $services{servers}->{$url}{$username};
            my $lists = $service->{lists};
            # printf "[%s]\n", $url;
            for my $list (@$lists) {
                next if $config->{nomod}{$list->{listAddress}};
                moderate_list($service,$username,$list,0);
            }
        }
    }
}

sub moderate_list {
    my($service,$username,$list,$verbose) = @_;
   
    unless ($list->{isOwner} || $list->{isEditor}) {
        printf "You can't moderate %s.\n", $list->{listAddress}
          if $verbose;
        return;
    }
    
    printf "Pending requests for %s... ", $list->{listAddress};
    my ($shortname,$domain) = split("@",$list->{listAddress});
    my $response =
      $service->{soap}->authenticateAndRun($username,
                                           $service->{md5},
                                           "showModQueue",
                                           [ $list->{listAddress} ],
                                          );

    if ($response->faultcode) {
        printf "Error.\n";
        my $detail = $response->faultdetail || "";
        printf(STDERR "Error: %s, %s.\n",
               $response->faultstring, 
               $detail,
              ) if $debug;
        return;
    }
    
    my $nummods = @{$response->result};
    printf "%d items.\n", $nummods;
    # print Dumper($response->result);
    # printf "'%s'\n", $response->result;
    my $i = 0;
    
  MESSAGE:
    for my $mod ( @{$response->result} ) {            
        next unless defined $mod;
        #print Dumper($mod);
        # next;
        my $modtype = $mod->{modtype};
        if ($modtype eq "message") {
            printf("[%d/%d] Message request %s (%s)\n",
                   ++$i,
                   $nummods,
                   $mod->{id_str},
                   $list->{listAddress},
                  );

            my $done = 0;
            my $auto = 0;
            my $longaction = "skipped";
            while (!$done) {
                my $action = '';

                { 
                    no warnings "all";
                    no open;

                    printf "\t From: %s\n", utf2locale($mod->{from});
                    printf "\t Date: %s\n", utf2locale($mod->{date});
                    printf "\t Subject: %s\n", utf2locale($mod->{subject});
                    printf "\t Size (Kb): %s\n\n", $mod->{size};
                }

                # Check automatic processing rules
                for my $rule (@{$config->{modrules}}) {
                    my ($raction, $rregexp) = @$rule;
                    if ($mod->{message} =~ $rregexp) {
                        # next MESSAGE;
                        $auto = 1;
                        $action = $raction;
                    }
                }

                # no automoderation, so ask user
                unless ($action) {
                    printf "(A)pprove, (R)eject, (D)iscard, (V)iew message, (S)kip? ";
                    $action = <STDIN>;
                    chomp($action);
                    $action = $mod_actions{lc $action} 
                      if $mod_actions{lc $action};
                }
                $action ||= 'skip';
                $done = 1;
                if ($action eq "approve") {
                    if (do_mod ($mod->{id_str}, "DISTRIBUTE", $shortname, $domain, 
                                $username, $service->{md5}, $service->{soap})) {
                        $longaction = "approved";
                    } else {
                        $longaction = "skipped. Error when approved";
                    }
                } elsif ($action eq "reject") {
                    if (do_mod ($mod->{id_str}, "REJECT", $shortname, $domain, 
                                $username, $service->{md5}, $service->{soap})) {
                        $longaction = "rejected";
                    } else {
                        $longaction = "skipped. Error when rejected";
                    }
                } elsif ($action eq "discard") {
                    if (do_mod ($mod->{id_str}, "QUIET REJECT", $shortname, $domain, 
                                $username, $service->{md5}, $service->{soap})) {
                        $longaction = "discarded";
                    } else {
                        $longaction = "skipped. Error when discarded";
                    }
                } elsif ($action eq "skip") {
                    $longaction = "skipped";
                } elsif ($action eq "view") {
                    # TODO: Only show first 500 lines
                    printf "\nShow message:\n\n%s\n\n", $mod->{message};
                    $done = 0;
                }
            }    
            printf "Message was %s%s.\n\n", $auto?"automatically ":"", $longaction;
        } elsif ($modtype eq "subscription") {
            printf "[%d/%d] Subscription request for list %s \n", ++$i, $nummods, $list->{listAddress};
            printf "\t From: %s\n", utf2locale($mod->{modaddress});
            printf "\t Date: %s\n", utf2locale($mod->{moddate});
            printf "\t Full name: %s\n", utf2locale($mod->{modfullname});
            printf "(A)pprove, (R)eject, (S)kip? ";
            my $action = <STDIN>;
            my $longaction = "skipped";
            chomp($action);
            if ($action eq "A" || $action eq "a") {
                if (do_mod_subs ($mod->{id_str}, "APPROVE", $shortname, $domain, 
                                 $username, $service->{md5}, $service->{soap})) {
                    $longaction = "approved";
                } else {
                    $longaction = "skipped. Error when approved";
                }
            } elsif ($action eq "R" || $action eq "r") {
                if (do_mod_subs ($mod->{id_str}, "REJECT", $shortname, $domain, 
                                 $username, $service->{md5}, $service->{soap})) {
                    $longaction = "rejected";
                } else {
                    $longaction = "skipped. Error when rejected";
                }
            } elsif ($action eq "S" || $action eq "s") {
                $longaction = "skipped";
            }
            printf "Subscription request was %s.\n\n", $longaction;
        }
    }  
}

sub do_mod {
    my ($msg, $cmd, $list, $domain, $username, $md5, $soap) = @_;
    my $response = $soap->authenticateAndRun($username,$md5,
                                             "doModMsgs",
                                             [ $cmd, $list, $domain, $msg ],
                                            );
    if ($response->fault) {
        printf STDERR "Error: %s, %s.\n", $response->faultstring, $response->faultdetail;
        return 0;
    }    
    return 1;
}

sub do_mod_subs {
    my ($msg, $cmd, $list, $domain, $username, $md5, $soap) = @_;
    my $response = $soap->authenticateAndRun($username,$md5,
                                             "doModSubs",
                                             [ $cmd, $list, $domain, $msg ],
                                            );
    if ($response->fault) {
        printf STDERR "Error: %s, %s.\n", $response->faultstring, $response->faultdetail;
        return 0;
    }    
    return 1;
}

sub cmd_add_member {
    my ($arg) = @_;
    my(@members,@lists);

    # either "(addr addr addr ...)"
    if ($arg =~ s/^\s*\(([^()]+)\)\s+//) {
        @members = split " ", $1;
    } elsif ($arg =~ s/^\s*(\S+)\s*//) {
        # or just "addr"
        @members = ($1);
    }

    # just in case, split addr on ","
    @members = grep { length } map { split /\s*,\s*/, $_ } @members;

    # and the same for lists
    if ($arg =~ s/^\s*\(([^()]+)\)\s+//) {
        @lists = split " ", $1;
    } elsif ($arg =~ s/^\s*(\S+)\s*//) {
        @lists = ($1);
    }
    @lists = grep { length } map { split /\s*,\s*/, $_ } @lists;
    
    for my $member (@members) {
        for my $list (@lists) {
            printf STDERR "%s --> %s\n", $list, $member if $debug;
            add_member($member, $list);
        }
    }
    return 1;
}

sub cmd_remove_member {
    my ($arg) = @_;
    my(@members,@lists);

    if ($arg =~ s/^\s*\(([^()]+)\)\s+//) {
        @members = split " ", $1;
    } elsif ($arg =~ s/^\s*(\S+)\s*//) {
        @members = ($1);
    }
    @members = grep { length } map { split /\s*,\s*/, $_ } @members;

    if ($arg =~ s/^\s*\(([^()]+)\)\s+//) {
        @lists = split " ", $1;
    } elsif ($arg =~ s/^\s*(\S+)\s*//) {
        @lists = ($1);
    }
    @lists = grep { length } map { split /\s*,\s*/, $_ } @lists;
    
    for my $member (@members) {
        for my $list (@lists) {
            printf STDERR "%s --> %s\n", $list, $member if $debug;
            remove_member($member, $list);
        }
    }
    return 1;
}

sub add_member {
    my ($member, $listaddress, $quiet) = @_;
    my $hash = $alllists{alllists}->{$listaddress};
    unless (defined($hash)) {
        printf STDERR "Could not find list with name '%s'.\n", $listaddress;
        return 0;
    } else {
        my $service = $services{servers}{$hash->{url}}{$hash->{username}};
        if (defined($service)) {
            my $response;
            if ($quiet) {
                $response =
                  $service->{soap}->authenticateAndRun($hash->{username},
                                                       $service->{md5},
                                                       "add",
                                                       [ $listaddress, $member, "", 1 ],
                                                      );
            } else {
                $response = 
                  $service->{soap}->authenticateAndRun($hash->{username},
                                                       $service->{md5},
                                                       "add",
                                                       [ $listaddress, $member ],
                                                      );
            }
            if (!$response->faultcode) {
                printf "Added %s to %s.\n", $member, $listaddress;
            } else {
                printf STDERR "Error: %s, %s.\n", $response->faultstring, $response->faultdetail;
                printf STDERR "Failed to add %s to %s\n\n", $member, $listaddress;
            }
        } else {
            printf STDERR "Could not find a suitable soap service for list with name '%s'.\n", $listaddress;
            return 0;
        }
        # my $response = $service->{soap}->authenticateAndRun($hash->{username},$service->{md5}, "signoff", [ "*" ]);
    }
}

sub remove_member {
    my ($member, $listaddress) = @_;
    my $hash = $alllists{alllists}->{$listaddress};
    unless (defined($hash)) {
        printf STDERR "Could not find list with name '%s'.\n", $listaddress;
        return 0;
    } else {
        my $service = $services{servers}{$hash->{url}}{$hash->{username}};
        if (defined($service)) {
            my $response = 
              $service->{soap}->authenticateAndRun($hash->{username},
                                                   $service->{md5},
                                                   "del",
                                                   [ $listaddress, $member ],
                                                  );
            if (!$response->faultcode) {
                printf "Removed %s from %s.\n", $member, $listaddress;
            } else {
                printf STDERR "Error: %s, %s.\n", $response->faultstring, $response->faultdetail;
                printf STDERR "Failed to remove %s from %s.\n\n", $member, $listaddress;
            }
        } else {
            printf STDERR "Could not find a suitable soap service for list with name '%s'.\n", $listaddress;
            return 0;
        }
    }
}

sub cmd_list_members {
    my ($listaddress, $services, $alllists) = @_;
    my $hash = $alllists{alllists}->{$listaddress};
    unless (defined($hash)) {
        printf STDERR "Could not find list with name '%s'.\n", $listaddress;
        return 0;
    } else {
        my $service = $services{servers}{$hash->{url}}{$hash->{username}};
        if (defined($service)) {
            my $response =
              $service->{soap}->authenticateAndRun($hash->{username},
                                                   $service->{md5},
                                                   "review",
                                                   [ $listaddress ],
                                                  );

            if (!$response->fault) {
                my $nummembers = @{$response->result};
                printf "%d members subscribed to list %s.\n", $nummembers, $listaddress;
                print "\n" if $nummembers > 0;
                for my $member ( @{$response->result}) {
                    printf "\t%s\n", $member;
                }
                print "\n\n";
            }
        } else {
            printf STDERR "Could not find a suitable soap service for list with name '%s'.\n", $listaddress;
            return 0;
        }
    }
}

sub print_result {
    my $r = shift;
    my @ret;
    
    # If we get a fault
    if (defined $r && $r->fault) {
        print "Soap error :\n";
        my %fault = %{$r->fault};
        foreach my $val (keys %fault) {
            print "$val = $fault{$val}\n";
        }
    } else {
        if (ref( $r->result) =~ /^ARRAY/) {
            #printf "R: $r->result\n";
            @ret = @{$r->result};
        } elsif (ref $r->result) {
            printf "Pb $r->result\n";
            return undef;
        } else {
            @ret = $r->result;
        }
        # dump_var(\@ret, 0, \*STDOUT);
        # print Dumper(\@ret);
    }

    return 1;
}

sub getResult {
    my $r = shift;
    my @ret;

    # If we get a fault
    if (defined $r && $r->fault) {
        #?
    } else {
        if (ref( $r->result) =~ /^ARRAY/) {
            @ret = @{$r->result};
        } elsif (ref $r->result) {
            #?
        } else {
            @ret = $r->result;
        }
    }
    # print Dumper(\@ret);
    return @ret;
}

sub dump_var {
    my ($var, $level, $fd) = @_;

    return undef unless ($fd);

    if (ref($var)) {
        if (ref($var) eq 'ARRAY') {
            foreach my $index (0..$#{$var}) {
                print $fd "\t"x$level.$index."\n";
                &dump_var($var->[$index], $level+1, $fd);
            }
        } elsif (ref($var) eq 'HASH' ||
               ref($var) eq 'Scenario' || 
               ref($var) eq 'List') {
            foreach my $key (sort keys %{$var}) {
                print $fd "\t"x$level.'_'.$key.'_'."\n";
                &dump_var($var->{$key}, $level+1, $fd);
            }    
        } else {
            printf $fd "\t"x$level."'%s'"."\n", ref($var);
        }
    }
    else {
        if (defined $var) {
            print $fd "\t"x$level."'$var'"."\n";
        } else {
            print $fd "\t"x$level."UNDEF\n";
        }
    }
}

sub utf2locale {
    my($str) = @_;
    return encode('locale', decode_utf8($str))
}

our $AUTOLOAD;
sub AUTOLOAD {
    my $cmd;
    if ($AUTOLOAD =~ /::cmd_(.*)/) {
        $cmd = $1;
        $cmd =~ s/_/ /g;
    }

    if ($debug) {
        printf STDERR "Undefined subroutine %s called\n", $AUTOLOAD;
        printf STDERR "  at %s:%d\n", (caller)[1,2];
    } else {
        if ($cmd) {
            printf "Sorry, '%s' isn't implemented yet...\n", $cmd;
        } else {
            printf "Somthing went wrong, enable debug and try again...\n";
        }
    }
    
    if ($cmd) {
        return 0;
    }
    return;
}


__END__


=encoding utf-8

=head1 NAME

sympaadmin - administrate sympa mailing lists from the command line

=head1 SYNOPSIS

B<sympaadmin>
[B<-f> I<CONFIGFILE>]
[B<-d>]
[B<--help>]
[B<--version>]
[I<cmd>] 
...

=head1 DESCRIPTION

I<sympaadmin> is a terminalbased tool for administrating sympa mailing
lists.

It has three user modes:

=over

=item *

When given arguments, it will parse and execute these and then exit.

=item *

When input is piped from the command line, it will parse and execute the
input and then exit.  This is useful when you want to operate on much
data, for example subscribe a large number of people to lists.

=item *

When started without arguments it will start a command loop and give you
a sympa shell to operate from.

=back
    
=head1 OPTIONS

=over

=item B<-d>, B<--debug>

Enable debug mode. More verbose output.

=item B<-v>, B<--version>

Print version and exit.

=item B<-h>, B<--help>

Print help text and exit, use B<-h -h> to get the full manpage.

=item B<-f> I<CONFIGFILE>, B<--config> I<CONFIGFILE>

Specify config file to be used. Defaults to
F<$HOME/.sympaadmin.ini>. See the L</FILES> section in the manpage for
more info on what this file should contain.

=back

=head1 ARGUMENTS

=over

=item B<help>

Show full help.

=item B<add> I<ADDRESS> I<LISTADDRESS>

=item B<add> (I<ADDRESS>+) I<LISTADDRESS>

=item B<add> I<ADDRESS> (I<LISTADDRESS>+)

=item B<add> (I<ADDRESS>+) (I<LISTADDRESS>+)

Add the e-mail address I<ADDRESS> to the sympa list I<LISTADDRESS>.
Multiple addresses and lists can be specified if the list is either
enclosed in C<( )> and sparated with C< >, or just separated with C<,>.

=item B<remove> I<ADDRESS> I<LISTADDRESS>

=item B<remove> (I<ADDRESS>+) I<LISTADDRESS>

=item B<remove> I<ADDRESS> (I<LISTADDRESS>+)

=item B<remove> (I<ADDRESS>+) (I<LISTADDRESS>+)

Remove the e-mail address I<ADDRESS> from the sympa list I<LISTADDRESS>.
Multiple addresses and lists can be specified if the list is either
enclosed in C<( )> and sparated with C< >, or just separated with C<,>.

=item B<list> B<all>

List all the sympa list you are associated with.

=item B<list> B<admin>

List all the lists you have administrator rights to.

=item B<list> B<memberships>

List all the lists you are a member of.

=item B<list> B<members> I<LISTADDRESS>

List all members of the sympa list LISTADDRESS.

=item moderate

Starts interactive moderation of all the lists you have administrator
rights to.

=back

=head1 FILES

B<sympaadmin> uses the following files:

=over

=item F<.sympaadmin.ini>

F<$HOME/.sympaadmin.ini> is the default config file used by sympaadmin.
You can specify another file to use with the I<-f> or I<--configfile>
option on the command line.

The configfile should contain something like the following example:

    soapuser = ADDRESS
    soapserver = SOAPSERVER
    soapserver = SOAPSERVER

    soapuser = ADDRESS
    soapserver = SOAPSERVER

    nomoderate = LISTADDRESS
    nomoderate = LISTADDRESS

    automod = MODACTION MODEXPRESSION
    automod = MODACTION MODEXPRESSION

I<ADDRESS> must be the address you are associated with the list with.
Typically your primary address on UiO.

I<SOAPSERVER> should be a valid URL to a Sympa SOAP server.  Here on UiO
such URLs are on the form C<https://sympa.uio.no/I<domain>-sympasoap>.

The I<LISTADDRESS> parameter to B<nomoderate> specifies a list that you
do not want to use sympaadmin to moderate even though you are an
administrator of the list.

The B<automod> directive defines a predefined moderation action based
on the following rule. You can have as many automod entries as you
likes.

I<MODACTION> must be either B<skip>, B<approve>, B<discard> or
B<reject>. When throwing away spam, B<discard> should be used.

I<MODEXPRESSION> may have the following syntax: 
    header: value
    value
If it begins with B<header:>, then sympaadmin will try to match value
in the header named B<header>. Otherwise it will try to match it
against the message body.
B<value> can either be a regular expression or a plain string.


An example config file:

    soapuser =  benteaa@ifi.uio.no
    soapserver = https://sympa.uio.no/ifi.uio.no-sympasoap

    soapuser =  b.c.aasgaard@usit.uio.no
    soapserver = https://sympa.uio.no/uio.no-sympasoap 

    nomoderate = postmaster@usit.uio.no

    automod = discard Subject: ^Out of office
    automod = discard Subject: viagra
    automod = approve Subject: ^\[[^#]#\d+\]
    automod = discard X-Spam-Score: *****

=back

=head1 EXAMPLES

To add the user ola.nordmann@uio.no to the list test@uio.no:

    bash$ sympaadmin add ola.nordmann@uio.no test@uio.no

or
    
    bash$ echo "add ola.nordmann@uio.no test@uio.no" | sympaadmin

or

    bash$ sympaadmin
    sympaadmin> add ola.nordmann@uio.no test@uio.no

=head1 SEE ALSO

  https://www.uio.no/tjenester/it/e-post-kalender/e-postlister/sympaadmin/

=head1 AUTHORS

  Øystein Gyland <oystein.gyland@usit.uio.no>
  Bente Christine Aasgaard <b.c.aasgaard@usit.uio.no>
  Peder Stray <peder@ifi.uio.no>
  Johnny A. Solbu <johnny@solbu.net>

=head1 PROJECT MANAGER

  Johnny A. Solbu <johnny@solbu.net>

=cut

