#!/usr/bin/perl -w
##
## subscribe
##
# This program allows users to subscribe (or unsubscribe) to a
# mailing list by sending blank email to an email address dedicated
# to that function (such as listname-unsubscribe@yourlistserver.com).
# This makes life easy for users, as they don't have to remember the
# syntax. It's also nice for the administrators.
# When subscribing, users can put their full name in the Subject line
# or the first line of the body. Otherwise, this program will attempt
# to extract their full name from their email address. 
#
# How to install/configure:
# Make sure you have Perl 5.x on your system. Put this program
# in your Listproc support directory (or anywhere else) and make
# sure it is executable by sendmail. Edit the path in the configuration
# section. Add two sendmail aliases for each list to handle
# subscriptions and unsubscriptions (example below).
#
# Usage:
# /opt1/listproc/support/subscribe [-d] [-u] -L <listname>
#
#   -d is a debug flag
#   -u is for unsubscribe (default is subscribe)
#   -L specifies the list on which to perform the action
#
# Example as a sendmail alias:
# listname-subscribe:   "|/opt1/listproc/support/subscribe -L listname"
# listname-unsubscribe: "|/opt1/listproc/support/subscribe -u -L listname"
#
# How it works:
# Normally, users send an email to listproc with the subscription request
# in the body of the message. Listproc is a sendmail alias that sends the
# message to the catmail program. This "subscribe" script is also a
# sendmail alias, but it formats the proper (un)subscription command
# automatically before sending it to catmail.
# 
# This was inspired by an idea from David Rosenthal (davidr@shamash.org).
# It has been tested on Listproc 8.2 and various versions of Sendmail.
# I welcome any comments, requests, suggestions, etc.
#
# Author: Mark Thomas (mark_thomas@usa.net)
#
# Version history:
# 1.00      3/29/99 Tested, added more comments and removed beta designation
# 1.00b1    3/24/99 Initial version

use Getopt::Std;   #perl built-in module to handle cmd-line args

###################################################################
# Configuration section
#
# Path to listproc's catmail executable
$catmail = '/opt1/listproc/catmail';
###################################################################

# Get command-line arguments
getopts("duL:");
my ($debug,$unsubscribe,$listname) = ($opt_d,$opt_u,$opt_L);
print "Debug mode enabled\n" if $debug;
die "usage: $0 [-d] [-u] -L <listname>\n" unless $listname;

# We will be sending the message to Listproc's catmail command
# unless we are debugging, in which case everything goes to STDOUT.
if ($debug) {
    open (CATMAIL,">&STDOUT") or warn "Can't dup STDOUT: $!";
}
else {
    open (CATMAIL,"|$catmail -r -f") or die "Can't forward post to listproc: $!";
}

# Send message to catmail
while(<>) {
            print CATMAIL;
    # Get full name from subject line
    $name = $1 if /^Subject:\s*(.*)$/;
    # Attempt to extract name from email address
    # e.g. "Mark Thomas <mark_thomas@usa.net>" -> Mark Thomas
    $from = $1 if /^From:\s*(.*)\s*[\[<]/;
    # empty line signifies end of headers 
    last if (/^$/);
}

# Send subscribe or unsubscribe command

if ($unsubscribe) {
    $command = "unsubscribe $listname\n";
}
else {
    
    # For subscribe, we need to determine the name.
    # Let's try four things, in this order:
    # 1. Use subject line, if something's there
    # 2. Use first non-blank body line
    # 3. If none of the above exist, extract one from the email address
    # 4. As a final resort, use "No Name Given".

    if ($name !~ /\w/) {
        # If name is not in subject,
        # read body for a name,
        # skipping blank lines.
        while(<>) {
            next if (/^$/);
            $name = $_;
            chomp ($name);
        }   
    }
    if (!$name) {
        # If we still don't have a name,
        # use name extracted from From: line,
        # or as a last resort specify one.
        if ($from) {
            $name = $from;
        }
        else { $name = "No Name Given"; }
    }
    $command = "subscribe $listname $name\n";  
}
print CATMAIL $command;

close (CATMAIL);