#!/usr/bin/perl
#
# md-sub.cgi
#
# Author: John Orthoefer <jco@direwolf.com>
# Date: 17 Jan 1996
# 
# Introduction
#   This cgi allows people web surfing to subscribe to mailing list.
#   It presents the person with a form when called with out options.
#   when called with options it will send a mail message to the 
#   mailing list.
#
# Installing
#   To install this software:
#     o put the script in the cgi-bin directory
#     o set the following varables up for your site
#         cgiloc   - url of this script as refered to via the web
#         listsdb  - where the database of lists is going to live
#         logfile  - where the log for script activity should go
#         sendmail - the sending e-mail program, it should have the
#                    option to read the incoming stream for the To
#                    address set, '-t' on sendmail.
#     o initialize the database
#       + list all your mailing lists and contact addresses in a file
#         one per line as in
#            firewalls          majordomo@greatcircle.com
#            warhammerfb        majordomo@direwolf.com
#            majordomo-workers  majordomo@greatcircle.com
#            default            warhammerfb
#            help               webmaster@here.org
#
#         note: there are 3 special names
#            default  -- This is the mailing list that will be 
#                        selected when the form is first
#                        presented to the user.
#            help     -- This is the address for people to send 
#                        help to.
#            info     -- This is used to specify a URL for information about
#                        a mailing list.
#                        the format is:
#                           info listname url
#                        where: listname matches a list that is specifed 
#                                   elsewhere in the file.
#                               url is some url on the web.
#       + then run the the script with the '-C filename' option 
#         to construct the database.  The create option will only 
#         add to the database.  If you want to clear the database, 
#         you need to 'rm $listsdb*' (there will be two file a 
#         .dir and .pag file.)
#    o add a link to the scripts URL in your web pages.
#       + if you want to make different default mailing lists based on
#         which pages you came from you can do this by passing the param
#            default=listname 
#         as part of the URL.
#         ie:   <href url="http://mypage.domain.org/md-sub.cgi?default=mylist">
#         This will cause mylist to be the default selected one instead of 
#         the database default.
#
# Misc
#   This script needs two perl libs cgi-lib.pl (included in this 
#   distrubution.) and getopts.pl (which should be included with 
#   your perl distrubution.)
#
# Scalars that need to be changed
#
$cgiloc   = "http://uls.fam.cx/cgi-bin/heptavia.cgi";
$listsdb  = "/usr/local/mail/.md-subrc";
$logfile  = "/usr/local/mail/md-sub.log";
$sendmail = "|/usr/sbin/sendmail -t";
#$sendmail = "|/bin/cat - > /tmp/test.out"; # This one is for 
				#  testing...


# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
#             NOTHING BELOW HERE SHOULD NEED TO BE CHANGED
# !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

#
# Required file
require 'cgi-lib.pl';
require 'getopts.pl';
require './jcode.pl';
#
# Version number
$version = "1.0";

#
# Info
$info = "jco\@direwolf.com";
$inform ="heptavia-approval";
$mes1 = "下記の新メンバーが加入申請しました";


#
# Call Getopts
&Getopts( 'C:v');

#
# Check to see if we are creating a DB
if ($opt_C) {
    &create_lists( $opt_C);
    exit 0;
}

#
# Check to see if the version is being intergated.
if ($opt_v) {
    print "Version: $version\n";
    exit 0;
}

#
# Read the list DB
&load_lists;

#
# Figure out if we have a filled in form or we need to send a form
if (&ReadParse && !defined( $in{ 'default'})) {
    if (defined $in{ 'infopage'} ) {
       &infopage;
    } else {
       $in{ 'mailing_list'} =~ s/\*$//;  # drop the * at the end of the name.
       &sendmessage;
    }
} else {
    &form;
}

#
# Birthday party, cheesecake, jelly bean, boom!
#             R.E.M.
exit 0;

#
# create_lists
#   Create the DBM file.
sub create_lists {
    local( $file) = @_;

    open( LISTS, $file);
    dbmopen( %MLRC, $listsdb, 0644);

    while( <LISTS>) {
	chop;
	($name, $address) = /(\S*)\s*(.*)/;
	if ($name =~ /info/i) {
	   ($name, $address) = $address =~/(\S*)\s*(.*)/;
           $MLRC{ "LISTINFO-$name"} = $address;
	   @info = (@info, $name);
	} else {
	   @ml = (@ml, $name);
	   $MLRC{ "LISTNAME-$name"} = $address;
	}
    }

    $MLRC{ 'mailing-lists'} = join( ";", @ml);
    $MLRC{ 'mailing-info'} = join( ";", @info);
    dbmclose( MLRC);
}

#
# load_lists
#   read in the DBM file.
sub load_lists {
    if (!dbmopen( %MLRC, $listsdb, undef)) {
	&log( "Can't open $listsdb");
	exit 1;
    }

    foreach $i (split(/;/, $MLRC{'mailing-lists'})) {
	$ml{$i} = $MLRC{ "LISTNAME-$i"};
    }

    foreach $i (split(/;/, $MLRC{'mailing-info'})) {
	$mi{$i} = $MLRC{ "LISTINFO-$i"};
    }

    dbmclose( MLRC);
}

#
# form
#   Present the form to the user to fill out
sub form {

# Form header
    print <<EOF;
Content-type: text/html

<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=x-euc-jp">
<title>Mailing List Subscription</title>
</head>
<body bgcolor="#c8f5fb">
<font size=+3>
<center><b><font color="#fa8072"<U>メーリングリスト加入フォーム</font></U></B></Center>
</font>
<br>
<ol>
<LI>メーリングリストへの加入の場合はML名を<br>選びます。
<br>
<LI>メーリングリストに加入するには、下の記入枠内に加入者名、メールアドレスを<br>
書き込みます。<BR>
<LI>E-mailアドレスはABC00123\@nifty.ne.jpなどのように正確にキッチリと入力して下さい。<br>また、アドレスの前には名前、略称などは付けないで下さい。
<br>山田&lt;abc\@efg.com&gt;などの形式は不可です。
<LI>最後に、加入、脱退、加入者リストの要求、詳細説明の区別
を選んで、要求のボタンをクリックしてください。<BR>
</ol>

EOF

if (defined %mi) {
 print <<EOF;

メーリングリストの名前がabcdefg*と(*)が付いているのは、別途説明のページが用意
されていることを示しています。
説明のページを表示するには<a href=\"http://xxxxxxxxxx/info.html\"><B>ここをクリック</B></a>
してください。

EOF
}

print <<EOF;
<hr>
<form action="$cgiloc" method="post">
メーリングリスト:
EOF

# Generate the list of mailing lists
    print "<select name=\"mailing_list\">\n";
#	   print "<option selected>$i";
	   print "<option selected>heptavia*";
           print "<option>test";
           print "\n";
           print "</select>\n";

# form trailer
print <<EOF
<br>
加入者名: <input type="text" name="rname" size=30> <br>
E-mailアドレス: <input type="text" name="email" size=30> <br>
<br>
希望の処理内容を選んでください。
<blockquote>
<input checked type=radio name="function" value="subscribe">メーリングリストへの加入<br>
<input type=radio name="function" value="unsubscribe">メーリングリストからの脱退<BR> 
<input type=radio name="function" value="who">メーリングリストの加入者リストのメールによる入手<br>
<input type=radio name="function" value="info">詳細説明のメールによる入手<br> 
</blockquote>
<input type="submit" value="要求の送信"> 
<input type="reset" value="Reset">

</form>
<hr>
<address>
<a href="mailto:$ml{ 'help'}">Webmaster</a> / 
<a href="mailto:$info>md-sub.cgi</a> /
$version
</address>
</body>
</html>
EOF
}

#
# infopage
#    This sends the page with all the info lists on it.

sub infopage {

print <<EOF;
Content-type: text/html

<html>
<title>Mailing List Information</title>
<body>
<font size=5>
<center><b>Mailing List Information</b></center>
</font>
<br>
<hr>
EOF
    print "<ul>\n";
    foreach $i (keys %mi) {
	    print "<li><a href=\"$mi{ $i}\">$i</a>\n";
    }
    print "</ul>\n";

print <<EOF;
<hr>
<address>
<a href="mailto:$ml{ 'help'}">Webmaster</a> / 
<a href="mailto:$info>md-sub.cgi</a> /
$version
</address>
</body>
</html>
EOF
}

#
# log
#    This routine is called to print data out to the log file it should
#    be trival to make it use syslog if you are so inclined.
sub log {
    local( $msg) = @_;


    open( LOG, ">>$logfile");

    print LOG &DTG;
    print LOG " - $msg\n";

    close( LOG);
    
}

#
# DTG
#    Date Time Group, This is a military thing.  Express time in GMT (aka 
#    Zulu) it this kinda funky format (ddhhmmZ MON YY).  I used it because 
#    it's a canned routine I have. 
sub DTG {
    local( $time) = @_;
    local( @months) = ( 'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', 
		       'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC');

    $time = time if ($time);
    sprintf( "%2.2d%2.2d%2.2dZ %s %2.2d", 
	    (gmtime( $time))[3],
	    (gmtime( $time))[2], 
	    (gmtime( $time))[1], 
	    @months[(gmtime( $time))[4]],
	    (gmtime( $time))[5]);
}

#
# sendmessage
#    This is the worker routine.  Sends a nice HTML message to the user and 
#    sends a nice e-mail to the mailing list admin.
# 
sub sendmessage {
    local( $i);

    if ($in{ 'email'} eq "") {
	print <<EOF;
Content-type: text/html

<html>
<font size=6>
<center><b>SORRY</b></center><br>
</font>
I'm sorry but you must fill in your e-mail address.
Press "back" and try again.
</html>
EOF

exit 0;
}
    $in{ 'email'} = "$in{ 'email'}@$ENV{'REMOTE_HOST'}" 
	if ( !( $in{ 'email'} =~ /\S*@\S*/));

    &log( "<$in{ 'email'}> \"$in{ 'rname'}\" ".
          "$in{ 'function'} $in{ 'mailing_list'}");

    open( SM, "$sendmail");
    print SM <<EOF;
To: $ml{$in {'mailing_list'}}
From: "$in{ 'rname'}" <$in{'email'}>
Reply-To: "$in{ 'rname'}" <$in{'email'}>

$in{ 'function'} $in{'mailing_list'}
EOF
    close( SM);
$temp = $in{ 'rname'};
&jcode'convert(*temp, "jis");
&jcode'convert(*mes1, "jis");

if($in{ 'function'} eq "subscribe"){
   open( SM, "$sendmail");
    print SM <<EOF;
To: $inform
From: $ml{$in {'mailing_list'}}
Subject: "New member"
\n\n$mes1\n\n\n
$temp <$in{'email'}>
EOF
    close( SM);
}

print <<EOF;
Content-type: text/html


<HTML>
<TITLE>Thank You</TITLE>
<BODY BGCOLOR="#faebd7">
<FONT SIZE=5>
<CENTER><B>THANK YOU</B></CENTER>
</FONT><br>
あなたの要求事項はメーリングリスト管理プログラムに送信しました。<br>
要求事項の実行結果はメールであなたお知らせします。しばらくお待ちください。<br>
<br>
<hr>
<br>
メーリングリスト管理プログラムに送信した内容は以下の通りです。
<br>
<br>
<TT>
EOF

    print "To: $ml{$in {'mailing_list'}}<br>\n";
    print "From: \"$in{ 'rname'}\" &lt;$in{'email'}&gt;<br><br>\n";

    print "$in{ 'function'} $in{'mailing_list'} <br>\n";

    print <<EOF;

</TT>
</BODY>
</HTML>
EOF

}