#!/usr/local/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
#

%passwd = (     "news_mlib" => 'news_mlib.admin' ,
                "shuffle"   => 'shuffle.admin',
		"Medical-LibraryNEWS" => 'medical-librarynews.admin'
          );

#$cgiloc   = "http://staff.lib.gunma-u.ac.jp/www-mlib/mailnews/mailindex.cgi";
#$listsdb  = "/usr/local/www/www-mlib/mailnews/md-subrc";
#$logfile  = "/usr/local/www/www-mlib/mailnews/md-sub.log";
#$sendmail = "|/usr/sbin/sendmail -t";


#$sendmail = "|/usr/bin/cat - > /usr/localwww/www-mlib/md-sub/test.out"; # This one is for 
				#  testing...
#$majordomo_lists_dir = "/usr/local/etc/majordomo-j/lists";

#
# for www.mlib.gunma-u.ac.jp
#
##$cgiloc   = "http://www.mlib.gunma-u.ac.jp/mailnews/index.cgi";
$cgiloc   = "http://www.lib.gunma-u.ac.jp/mlib/mailnews/index.cgi";
#$cgiloc   = "http://133.8.114.13/mailnews/index.cgi";
#$listsdb  = "/var/www/html/mailnews/.md-subrc";
##$listsdb  = "/usr/local/www/data/mailnews/md-subrc";
$listsdb  = "/usr/local/www/mlib/mailnews/md-subrc";
#$logfile  = "/var/www/html/mailnews/md-sub.log";
##$logfile  = "/usr/local/www/data/mailnews/md-sub.log";
$logfile  = "/usr/local/www/mlib/mailnews/md-sub.log";
$sendmail = "|/usr/sbin/sendmail -t";



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

#
# Required file
require 'cgi-lib.pl';
require 'getopts.pl';

#
# Version number
$version = "1.0";

#
# Info
$info = "jco\@direwolf.com";

#
# 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 {
    &formprint;
}


#
# 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 formprint {

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

<html><head>
<META http-equiv="Content-Type" content="text/html; charset=EUC-JP">
<META HTTP-EQUIV="Pragma" CONTENT="no-cache">
<META HTTP-EQUIV="Cache-control" CONTENT="no-store">
<META HTTP-EQUIV="Cache-control" CONTENT="no-cache">
<META HTTP-EQUIV="Expires" CONTENT="Mon, 1 Jan 1990 01:01:01 GMT">
<title>Mailing List Subscription</title>
</head>

<body>
<font size="5"> </font> <br>
<table align="center" border="0" cellspacing="0" width="90%">
  <!--DWLayoutTable-->
  <tbody>
    <tr>
      <td><a href="../index.html">群馬大学附属図書館医学分館</a></td> 
<!--       <td><a href="http://133.8.114.13/index.html">群馬大学附属図書館医学分館</a></td> -->
    </tr>
    <tr bgcolor="#009966">
      <td bgcolor="#009966"><font color="#dfffdf">メールニュース</font></td>
    </tr>
    <tr bgcolor="#009966">
      <td bgcolor="#ffffff"><h3 align="center">&nbsp;</h3>
        <h3 align="center">メールニュースの購読/中止について</h3>
        <div align="center"></div>
          <hr>
        <ul>
          <li>メールニュースを購読するには、お名前と 電子メールアドレスを記入の上、処理区分の購読にチェックをして、「送信」ボタンをクリックしてください。<br>
            <strong>Majordomo-j\@lib.</strong>より&quot;<strong>Confirmation for subscribe <em>[メールニュース]</em>
</strong>&quot;というタイトルのメールが送信されますので、そのメールに従って 
            、申込確認を行ってください。 <br>
            （イタズラ防止のため確認をしております。） </li>
          <li>購読を中止される場合は、お名前と 電子メールアドレスを記入の上、処理区分の停止にチェックをして「送信」ボタンをクリックしてください。</li>
          <li>送信に失敗することが続きますと、配信先から削除させていただく場合がございますのでご了承ください。</li>
        </ul>          
          <form action="$cgiloc" method="post">
            <table width="70%" align="center" cellpadding="3">
              <tbody>
                <tr>
                  
                <td width="37%" height="27" bgcolor="#c0c0ff">メールニュース：<font color="#FF0000" size="-3">必須</font></td>
                  <td width="63%">

EOF

    print "<select name=\"mailing_list\">\n";
    foreach $i (keys %ml) {
        next if ($i eq 'default');
        next if ($i eq 'help');
        if ( $i eq $in{ 'default'}) {
           print "<option selected>$i";
        } elsif ( $i eq $ml{ 'default'} && !defined( $in{ 'default'})) {
            print "<option selected>$i";
        } else {
            print "<option>$i";
        }
        print "*" if (defined $mi{ $i});
        print "\n";
    }
    print "</select>\n";

print <<EOF;
	</td>
                </tr>
                <tr>
                  
                <td bgcolor="#c0c0ff">あなたのメールアドレス：<font color="#FF0000" size="-3">必須</font></td>
                  <td><input type="text" name="email" size="30"></td>
                </tr>
                <tr>
                  <td bgcolor="#c0c0ff">おなまえ：</td>
                  <td><input type="text" name="rname" size="30"></td>
                </tr>
                <tr>
                  
                <td align="center" bgcolor="#c0c0ff"><div align="left">処理区分：<font color="#FF0000" size="-3">必須</font></div></td>
                  <td align="center"><div align="left">
                      <input type="radio" name="function" value="subscribe">
                    <b>購読</b><br>
                      <input type="radio" name="function" value="unsubscribe" checked="checked">
                    <b>停止</b>
                    <!-- 
<br>
<input type=radio name="function" value="who">
参加者一覧をメールで受け取る
<br>
<input type=radio name="function" value="info">
詳しい紹介をメールで受け取る
<br>
-->
                  </div></td>
                </tr>
                <tr>
                  <td height="52" align="center">&nbsp;</td>
                  <td align="center"><!-- <input type="submit" value="Send request">  -->
                      <div align="left">
                        <input type="submit" value="送　　信">
                        <!-- <input type="reset" value="Reset"> -->
                        <input type="reset" value="リセット">
                    </div></td>
                </tr>
              </tbody>
            </table>
          </form>   
          <hr>
          <p align="center">医学分館メールニュース担当<br>
          E-mail:<a href="mailto:$ml{ 'help'}">$ml{ 'help'}</a><br>
          </p>
          <p>&nbsp;</p></td>
    </tr>
    <tr bgcolor="#009966">
      <td bgcolor="#ffffff"><!--DWLayoutEmptyCell-->&nbsp;</td>
    </tr>
  </tbody>
</table>
</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) = @_;
    $imanojikan = localtime(time);

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

    print LOG &DTG;
    print LOG " - $msg form $ENV{'REMOTE_ADDR'} at $imanojikan\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>
電子メールアドレスが記入されていません。
申し込みページに戻って記入をやり直してください。
</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'}");

#
# subscribeの場合 リストにいないかどうか調べる。
#
if($in{ 'function'} eq 'subscribe'){

#$list_path = $majordomo_lists_dir . '/' . $in{'mailing_list'};
#
#open(LIST, $list_path);
#while(<LIST>){
#	chop;
#	if($in{'email'} eq $_){
#	print <<EOF;
#Content-type: text/html
#
#<html>
#<font size=6>
#<center><b>SORRY</b></center><br>
#</font>
#申込の電子メールアドレスはすでに登録済です。
#</html>
#EOF
#exit 0;
#	}
#}
#close(LIST);

$mail_list = lc $in{'mailing_list'};

    open( SM, "$sendmail");
    print SM <<EOF;
To: $ml{$in {'mailing_list'}}
X-From: "$in{ 'rname'}" <$in{'email'}>
From: mailnews\@lib.gunma-u.ac.jp
X-Reply-To: "$in{ 'rname'}" <$in{'email'}>

$in{ 'function'} $mail_list $in{'email'}
EOF
    close( SM);

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

<html>
<head>
<META http-equiv="Content-Type" content="text/html; charset=EUC-JP">
<META HTTP-EQUIV="Pragma" CONTENT="no-cache">
<META HTTP-EQUIV="Cache-control" CONTENT="no-store">
<META HTTP-EQUIV="Cache-control" CONTENT="no-cache">
<META HTTP-EQUIV="Expires" CONTENT="Mon, 1 Jan 1990 01:01:01 GMT">
<title>Thank You</title>
</head>


<body><br>
<table align="center" border="0" cellspacing="0" width="90%">
  <!--DWLayoutTable-->
  <tbody>
    <tr>
      <td><a href="../index.html">群馬大学附属図書館医学分館</a></td>
    </tr>
    <tr bgcolor="#009966">
      <td bgcolor="#009966"><font color="#dfffdf">メールニュース</font></td>
    </tr>
    <tr bgcolor="#009966"> 
      <td bgcolor="#ffffff"><h3 align="center">&nbsp;</h3>
        <h3 align="center">申し込みを受け付けました。</h3>
        <div align="center"></div>
        <hr> 
        <blockquote> 
          <p>購読申込を受け付けました。<br>
            <br>
            確認のため、<strong>Majordomo-j\@lib.</strong>より&quot;<strong>Confirmation 
            for subscribe 
EOF

$mail_list = lc $in{'mailing_list'};
print $mail_list;

    print <<EOF;
</strong>&quot;というタイトルのメールが送信されますので、そのメールに従って、申込確認を行ってください。 
            <br>
            <br>
            確定処理を行いませんとメールニュースは配信されません。よろしくお願いします。 </p>
        </blockquote>
        <h4>&nbsp; </h4>
        <hr> 
          <p align="center">医学分館メールニュース担当<br>
          E-mail:<a href="mailto:$ml{ 'help'}">$ml{ 'help'}</a><br>
          </p>

        <p>&nbsp;</p></td>
    </tr>
    <tr bgcolor="#009966">
      <td bgcolor="#ffffff"><!--DWLayoutEmptyCell-->&nbsp;</td>
    </tr>
  </tbody>
</table>
<font size="5">
<center>
</center>
</font>
</body></html>
EOF
#
# unsubscribeの場合 リストにいるかどうか調べる
#
}elsif($in{ 'function'} eq 'unsubscribe'){ 

#$list_path = $majordomo_lists_dir . '/' . $in{'mailing_list'};
#
#open(LIST, $list_path);
#
#$check = 0;
#while(<LIST>){
#	chop;
#	if($in{'email'} eq $_){
#		$check = 1;
#		close(LIST);
#		last;
#	}
#}
#close(LIST);

$check = 1;

if($check == 1){

$mail_list = lc $in{'mailing_list'};

    open( SM, "$sendmail");
    print SM <<EOF;
To: $ml{$in {'mailing_list'}}
X-From: "$in{ 'rname'}" <$in{'email'}>
From: mailnews\@lib.gunma-u.ac.jp
X-Reply-To: "$in{ 'rname'}" <$in{'email'}>

approve $passwd{$in{'mailing_list'}} $in{ 'function'} $mail_list $in{'email'}
EOF
    close( SM);

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

<html>
<head>
<META http-equiv="Content-Type" content="text/html; charset=EUC-JP">
<META HTTP-EQUIV="Pragma" CONTENT="no-cache">
<META HTTP-EQUIV="Cache-control" CONTENT="no-store">
<META HTTP-EQUIV="Cache-control" CONTENT="no-cache">
<META HTTP-EQUIV="Expires" CONTENT="Mon, 1 Jan 1990 01:01:01 GMT">
<title>Thank You</title>
</head>


<body><br>
<table align="center" border="0" cellspacing="0" width="90%">
  <!--DWLayoutTable-->
  <tbody>
    <tr>
      <td><a href="../index.html">群馬大学附属図書館医学分館</a></td>
    </tr>
    <tr bgcolor="#009966">
      <td bgcolor="#009966"><font color="#dfffdf">メールニュース</font></td>
    </tr>
    <tr bgcolor="#009966"> 
      <td bgcolor="#ffffff"><h3 align="center">&nbsp;</h3>
        <h3 align="center">購読の停止を受領しました。</h3>
        <div align="center"></div>
        <hr> 
        <blockquote> 
          <p>購読の停止を受領いたしました。<br>
            <br>
            購読が停止されますと、<strong>Majordomo-J\@lib.</strong>より&quot;<strong>メールニュースの配信を停止しました</strong>&quot;というタイトルのメールが送信されます。</p>
        </blockquote>
        <h4>&nbsp; </h4>
        <hr> 
          <p align="center">医学分館メールニュース担当<br>
          E-mail:<a href="mailto:$ml{ 'help'}">$ml{ 'help'}</a><br>
          </p>

        <p>&nbsp;</p></td>
    </tr>
    <tr bgcolor="#009966">
      <td bgcolor="#ffffff"><!--DWLayoutEmptyCell-->&nbsp;</td>
    </tr>
  </tbody>
</table>
<font size="5">
<center>
  <br>
</center>
</font>
</body></html>
EOF

}
#
# subscribe&&unsubscribeでない場合
}else{
print <<EOF
<HTML>
<TITLE>???</TITLE>
<BODY>
<FONT SIZE=5>
<CENTER><B>コマンドがおかしいです。</B></CENTER>
</FONT><br>
EOF
}
print <<EOF
</BODY>
</HTML>
EOF
}