skip to primary navigationskip to content
 

sync.pl

text/x-perl icon sync.pl — text/x-perl, 2 KB (2360 bytes)

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;
}


UIS Service Status

Phone padded  Service status line: (01223 7)67999
Website  Sign up for SMS/email status alerts
Website  Read major IT incident reports

UIS bITe-size bulletin


A regular newsletter aimed at the University's IT community, highlighting service and project news from UIS.

Sign up >

RSS Feed Latest news

Multi-factor authentication rollout on University Microsoft accounts

Apr 27, 2021

UIS is launching a project to roll out multi-factor authentication (MFA) on University Microsoft accounts.

University web search update on 30 April

Apr 22, 2021

We're updating the University web search engine to the latest version on Friday 30 April. Afterwards, it will look slightly different and some of the functionality will change.

View all news