LSTOWN-L Archives

LISTSERV List Owners' Forum

LSTOWN-L

Options: Use Monospaced Font
Show Text Part by Default
Show All Mail Headers

Topic: [<< First] [< Prev] [Next >] [Last >>]

Print Reply
Christopher Wilson <[log in to unmask]>
Sat, 23 Dec 2006 16:49:55 -0500
text/plain (125 lines)
Quick and dirty perl script to do what you want: (With apologies to SI
Warhurst for reusing/bastardizing his code :-))

-------------------------------------------------
#!/usr/bin/perl

# enter a site maintainer email address & password below
my $list = '';
my $adminemail = '';
my $adminpw = '';
my %nomails;
my %indexes;
my $command = 'QUERY ***GUI*** $list for *@*';
# === PROGRAM ==========================================

# form header into one line as expected by TCPGUI
my $sendhdr = "7_MAKE_WA13_MAKE_NOTEBOOK";
foreach(@lns){
        $sendhdr .= length($_)."_$_";
}

# send TCPGUI command
$return = lsvsend("$command");
@ret_lines = split /\n/, $return;
        foreach $line (@ret_lines) {
        chomp($line);
        if ($line =~ m/^\*\*\*HDR\*\*\*/) {
                ($hdr, $email) = split / /, $line;
                }
        if ($line =~ /^\*\*\*OPT\*\*\*/) {
                ($hdr, $opt) = split / /, $line;
                if ($opt =~ /^NOMAIL/) { $nomails{$email} = 1; }
                if ($opt =~ /^INDEX/) { $indexes{$email} = 1; }
                }
        }

# print results!
foreach $user (sort(keys(%nomails))) {
        if (defined($indexes{$user})) {
                print "$user\n";
                }
        }


# === SUBROUTINE ========================================

# Send TCPGUI commands to LISTSERV as administrator

sub lsvsend {

        my($cmd) = @_;
        my $email = $adminemail;
        $cmd .= " PW=$adminpw";

        # --- Connect to Listserv --- #

        use IO::Socket;
        my $lsv = IO::Socket::INET->new(
                Proto => "tcp",
                PeerAddr => "localhost",
                PeerPort => '2306')
        or die return "Error connecting to Listserv: $!";

        # --- Send Command --- #

        # form binary part of command header
        my $len = length($email)+length($cmd)+1;
        my $bin =
pack("a*CCCa*","\r\n",int($len/256),$len-(int($len/256)*256),length($email),$email);

        # send command header
        print $lsv "1B".$bin;
        recv($lsv, my $ans, 80, 0);
        if($ans !~ /^250/){
                return "Error sending command to Listserv: $ans";
        }

        # followed by command itself
        print $lsv "$cmd\n";

        # --- Get Reply --- #

        # get binary part of reply & decode
        read($lsv, $ans, 8);
        my @an = $ans =~ /.{4}/g;
        my $rcode = unpack("N", $an[0]);
        my $rlen = unpack("N", $an[1]);
        if($rcode != 0){
                return "Error getting reply from Listserv: $rcode (len
$rlen)";
        }

        # and get reply itself
        read($lsv, my $reply, $rlen);
        close $lsv; # close socket
        return $reply;
}

-----------------------------------------------------------------

-Chris

Winship wrote:
> On Sat, 23 Dec 2006, Pete Weiss wrote:
>> Unless your version of LISTSERV is broken (or older), then the command should work as you want.  I tried a couple on LISTSERV 14.5
>> YMMV
>> Q listname WITH DIGEST MIME FOR *@*
>> Q listname WITH DIGEST NOMIME FOR *@*
>> Indeed, both that options were true for the results displayed.
> 
> Thanks, Pete.  Does the order of the options matter, i.e. does it a dif.
> if it is
> Q listname WITH MIME DIGEST FOR *@*
> rather than
> Q listname WITH DIGEST MIME FOR *@*
> ?
> Douglas Winship  [log in to unmask]

-- 
Christopher Wilson
Information Systems Coordinator
ISS Enterprise Systems
The George Washington University
[log in to unmask]

ATOM RSS1 RSS2