The mailing list for listmasters using Sympa

[Dan Pritts <address@concealed>]

attached is a perl script i wrote to parse a sympa list config file.
Maybe useful to someone.  It was harder than i thought it would be.
and i couldn't figure out which sympa module/function to use to get
sympa to do the heavy lifting for me.

with a modern sympa it would be easier to just 'use Storable'
and read the config.bin files; except, note that this contains
the total config hash of the list, which includes values like
robot defaults, etc.  

danno
--
Dan Pritts, Sr. Systems Engineer
Internet2
office: +1-734-352-4953 | mobile: +1-734-834-7224

ESCC/Internet2 Joint Techs
July 11-15, 2010 - Columbus, Ohio
http://events.internet2.edu/2010/jt-oarnet/
#!/usr/bin/perl -w

use constant DEBUG => 0;

my $listdir="/home/sympa/list_data";

chdir $listdir;

sub dprint {
        return 1 unless (DEBUG);
        print $_[0];
        if ( $_[0] !~ /\n$/) { print "\n" };
        return 1;
}

# %lists{listname}{owneremail}=ownergecos
my %lists;
# %allowners{owneremail}=1 or not
my %allowners;
        
#foreach my $list ("tsg") {
foreach my $list (glob("*")) {
        &dprint($list);
        $conffyle="$listdir/$list/config";
        next unless -f $conffyle;

        {
                # $/ is the end-of-line indicator; undef lets it slurp 
                # the whole whoel file into one string
                local $/=undef;
                open (CONFIG, $conffyle) || die "Couldn't open $conffyle";
                $string = <CONFIG>;
                close CONFIG;
        }

        # remove comment lines
        $string =~ s{^#.*?$}{\n}mg;

        # remove excessive blank lines
        $string =~ s/\n\n+/\n\n/sg;

        my @config=split (/\n\n/,$string);
        #&dprint("config size is $#config");
        foreach $stanza (@config) {
                my @stanza=split(/\n/,$stanza);
                if ( $#stanza == 0 ) {
                        ($arg,$value)=split(/\s+/,$stanza[0]);
                        $lists{$list}->{$arg}=$value;
                        #&dprint("arg is $arg, value is $value\n\n");
                } else {
                        if ( ( defined $stanza[0] ) && ( $stanza[0] eq 
"owner" ) ) {
                                ($email,$gecos)=&parseowner(@stanza);
                                $allowners{$email}=1;
                                &dprint("owner stanza, $email, $gecos\n\n");
                                $lists{$list}->{'owners'}->{$email}=$gecos;
                        } else {
                                foreach $stanzaline (@stanza) { 
&dprint("line: $stanzaline") }
                                &dprint("\n");
                        }
                }
        }

}


sub parseowner {
        my $list=shift(@_);
        my $email=$gecos="";
        FOREACH: foreach my $line (@_) {
                if ($line =~ /(reception|profile)/) {
                        next FOREACH;
                }
                #&dprint(">parsing $line");
                chomp $line;
                if ( $line =~ /^\W*email/ ) {
                        $email=$line;
                        $email =~ s{^\W*\w+ }{};
                        $email = lc($email);
                        #&dprint(">>found email: $email");
                }
                if ( $line =~ /^\W*gecos/ ) {
                        $gecos=$line;
                        $gecos =~ s{^\W*\w+ }{};
                        #&dprint(">>found gecos: $gecos");
                }
        }
        return($email,$gecos);
}


# prints perl syntax containing a per-user array of lists owned.
# i included this in another script.
foreach my $luser ( keys %allowners) 
{
        # if you only wanted local users
        #next if $luser !~ /example\.com/;

        print q#$lusers{'#;
        print $luser; 
        print q#'}=[#;

        my %owners;
                foreach my $l (keys %lists) {
                        foreach my $owner (keys %{ $lists{$l}->{'owners'} }) {
                                $owners{$owner}++;
                        }
                        if ( defined ($lists{$l}->{'owners'}->{$luser} ) ) {
                                #print "$l\n";
                                print qq{"}.$l.qq{",};
                        }
        }

        # note q%% constructs
        print q%];%, qq%\n\n%;
}

# how many lists for each owner?
foreach my $owner (keys %owners) {
        print "$owners{$owner} lists owned by $owner .\n";
}


# which lists do these people own?
foreach my $luser ( 'address@concealed' ) {
        foreach my $l (keys %lists) {
                if (defined $lists{$l}->{'owners'}->{$luser}) {
                        print "$luser is an owner of $l\n";
                }
        }
}