File contents

#!/usr/bin/perl
#
# Small script to synchronise Sympa list with local list of addresses.
# Demonstrates API defined at https://lists.cam.ac.uk/sympasoap/wsdl
#
# REVIEW : get list of emails on list
#    ADD : Add subscriber to list
#    DEL : Remove subscriber from list
#
# Debian/Ubuntu dependencies: libsoap-lite-perl
#   libhttp-cookies-perl libterm-readpassword-perl
#
# Fedora/CentOS/RHEL dependencies: perl-SOAP-Lite
#   perl-HTTP-Cookies perl-Term-ReadPassword perl-LWP-Protocol-https

use strict;
use warnings;
use SOAP::Lite;
use HTTP::Cookies;
use Term::ReadPassword;

my $quiet    = "true";
my $listname_regexp = '^[\w\-]+$';
my $email_regexp    = '^\s*(\S+\@\S+\.\S+[^.\s])\s*$';

(@ARGV == 3) or die "$0: listname owner data-file\n";

my $soap_url = "https://lists.cam.ac.uk/sympasoap/wsdl";
my $listname = $ARGV[0];
my $owner    = $ARGV[1];
my $datafile = $ARGV[2];

($listname =~ m&$listname_regexp&)
    or die "Invalid listname: $listname\n";
($owner =~ m&${email_regexp}&o)
    or die "Invalid owner: $owner\n";

open my $fh, "<", $datafile
    or die "Failed to open $datafile: $!\n";

my %required = ();
while (<$fh>) {
    next if (m&^#& or m&^\s*$&);
    m&${email_regexp}&o
        or die "Invalid email address in $datafile: $_\n";
    $required{$1} = 1;
}
close($fh);

my $password = read_password("$owner Password: ");

my $cookie_jar = HTTP::Cookies->new();
my $soap = SOAP::Lite->proxy($soap_url, cookie_jar => $cookie_jar );
$soap->default_ns('urn:sympasoap');

my $obj = $soap->login($owner, $password);
($obj->fault)
    and die "Login failed: " . $obj->faultstring . "\n";

$obj = $soap->review( $listname );
($obj->fault)
    and die "REVIEW failed: " . $obj->faultstring . "\n";

my %existing = ();
foreach my $email (@{$obj->result}) {
    next if ($email eq "no_subscribers"); # Unhelpful quirk of REVIEW
    $existing{$email} = 1;
}

foreach my $email (sort keys %existing) {
    next if $required{$email};
    
    print "Removing: $email\n";
    $obj = $soap->del($listname, $email, $quiet);
    ($obj->fault)
        and die "Error removing $email: " . $obj->faultstring;
}

foreach my $email (sort keys %required) {
    next if $existing{$email};

    print "Adding: $email\n";
    my $obj = $soap->add($listname, $email, '', $quiet );
    ($obj->fault) and 
      die "Error adding $email: " . $obj->faultstring;
}