#!/usr/bin/perl -w

use lib "/home/alian/cgi-bin/site_perl";
use CGI qw/:standard :html3 :netscape escape unescape/;
use CGI::Carp qw/fatalsToBrowser/;
use Mail::POP3Client;
use MIME::Parser;
use MIME::QuotedPrint;
use strict;
use vars qw($style $homeurl $Client $Serv $Pass $Name @sizedisplay $start);
# Configuration
$homeurl = "/services"; # Url pour la page de retour
$style="/styles/pop.css"; # Url de la feuille de style utilisée
#-------------- End conf - ne pas modifier plus loin --------------------------

=head1 NAME

SimplePOP - Un CGI permettant de regarder/vider vos boites mails POP3

=head1 DESCRIPTION

simplePOP.cgi permet d'interroger un serveur POP3 afin de regarder sa messagerie.
Cela permet également de détruire les mails non désirés (virus, spam, ...).

=head1 INSTALL

Pour installer ce programme vous devez disposer du module Mail::POP3Client,
du package MailTools et d'un hébergement permettant les CGI.

Pour installer le module Mail::POP3Client, vous avez trois choix:

=over

=item *

Vous êtes administrateur, dans ce cas vous savez ce qu'il y a faire.
(module CPAN, search.cpan.org, ppm, ...)

=item *

Vous demandez à votre hébergeur de le faire

=item *

Vous n'avez pas d'assistance ... récupérer le module Mail::POP3Client
sur http://search.cpan.org, prenez le fichier POP3Client.pm et mettez-le
dans un répertoire Mail/. Utilisez ensuite la directive
use lib '/le/chemin/de/Mail'; pour indiquer à Perl où trouver le module.
Une fois ce module installé, adopter la même attitude pour les fichiers du
package Mailtools.

=back

Enfin positionnez le script dans un répertoire
acceptant les CGI, mettez-lui les droits en execution, modifiez au besoin
les variables $homeurl et $style en haut de fichier.

=head1 AUTHOR

Alain BARBET alian@alianwebserver.com Copyright 1/2001 v2.0
Update : Utilisation de CGI.pm, use strict, MIME::Parser, mise en page, cookies

Original Author Kerney Gouch (Lumiere Technologies) Copyright 7/1999 v1.0

=head1 FONCTIONS

=cut

my (@cookie);
if (param('pass')) {$Pass=param('pass'); push(@cookie,get_cookie('pass',param("pass"))); }
if (param('username')) {$Name = param('username'); push(@cookie,get_cookie('username',param("username")));}
if (param('server')) {$Serv=param('server');push(@cookie,get_cookie('server',param("server")));}
$start=param('start')||1;

print header(-cookie=>\@cookie);

$Client = &Connection if (param('server'));
if    (param('status') and param('status') eq "Read")    {&ReadMsg(param('Num')); }  # User just clicked on read message
elsif (param('status') and param('status') eq "Delete")  {&DeleteMsg(param('Num')); } # Delete message
elsif (param('server'))              {&Display; }  # Display the inbox of messages
else {print &Connect_screen();}


=over

=item titre($titre)

Cree l'entete HTML de la page

=cut

sub titre
     {
     my ($titre)=@_;
     return start_html(      -title=>$titre,
                            -author=>'alian@alianwebserver.com',
                            -base=>'true',
                            -meta=>{'keywords'=>'pop,mail,webmail',
                                        'copyright'=>'copyright 2001 Alain BARBET'},
                          -style=>{'src'=>$style}
                            )."\n";
     }

=item get_cookie($name,$value)

Positionne le cookie $name valeur $value pour 1 mois dans le repertoire cgi-bin

=cut

sub get_cookie
     {
     my ($name,$value)=@_;
     return cookie(-name=>$name,
                        -value=>$value,
                        -expires=>'+1M',
                        -path=>'/cgi-bin/',
                             #-domain=>'.capricorn.org',
                             );
     }

=item Connect_screen

Affiche l'ecran HTML de connection

=cut

sub Connect_screen
     {
     my $server = cookie(-name=>'server')||'';
     my $password = cookie(-name=>'pass')||'';
     my $user = cookie(-name=>'username')||'';
     my $buf=<<EOF;

<form method="POST">
<table border=1 cellspacing=0 cellpadding=0>
<tr>
     <td valign="top">Popmail username:</td>
     <td><input type="Text" name="username" size="25" value="$user"> <br></td>
     <input type="hidden" name="start" value="1">
     <input type="hidden" name="end" value="0">
</tr>
<tr>
     <td valign="top">Popmail server:</td>
     <td><input type="Text" name="server" size="25" value="$server"> <br></td>
</tr>
<tr>
     <td valign="top">Password:</td>
     <td><input type="password" name="pass" value="$password" size="25"> <br></td>
</tr>
</table>
<input type="Submit" name="popsub" value="Check Mail">
<input type="Reset" value="Clear Fields">
</form>
EOF
     return titre("Connect screen").h1("Connect screen").$buf.end_html;
     }


=item ReadMsg($Num)

Affiche l'ecran HTML pour le message $Num

=cut

sub ReadMsg
     {
     my ($Num) =@_;
     $Num++ if (param('Read') eq 'Next >>');
     $Num-- if (param('Read') eq '<< Previous');
     my $entity = getMailEntity($Num);
     my $header = $entity->head;
     my ($from,$subject,$to,$replyto) = (
                $header->get('From'),
                                         $header->get('Subject'),
           $header->get('To'),
           $header->get('Reply-to')
           );
     if ($from=~/(.*)<([\w\-\.]+\@[\w\-\.]*)>(.*)/) {$from="$1 <a href=\"mailto:$2\">$2</a> $3";}
     if ($to=~/(.*)<([\w\-\.]+\@[\w\-\.]*)>(.*)/) {$to="$1 <a href=\"mailto:$2\">$2</a> $3";}
     my $c = $Num;                    # message number
     my $bod = $entity->bodyhandle;
     my $body;
     #print "Type:",$entity->mime_type,"<br>";
     if ($entity->mime_type=~/multipart\//)
       {
       for (my $i=0;$i<$entity->parts;$i++)
         {
         my $ent = $entity->parts($i);
         #print $ent->mime_type,"<br>";
         if ($ent->mime_type=~/text\//)
           {
           next if (($ent->mime_type=~/text\/plain/) and ($entity->parts($i+1)->mime_type=~/text\/html/));
           next if ($ent->mime_type=~/text\/x-vcard/);
           my $b = $ent->bodyhandle->as_string;
           $b=~s/\n/\n<br>/g if ($ent->mime_type=~/text\/plain/);
           $body.=$b;
           }
         }       
       }
     else {$body=$entity->bodyhandle->as_string;$body=~s/\n/\n<br>/g;}

     print titre($header->get('Subject')),"\n
<hr>
<table>
  <tr><td><table width=\"100%\"><tr><td>",h1("Message # $Num"),"</td><td align=right>",Buttons($c),"</td></tr></table></td></tr>
  <tr>
     <td><table border=1 cellspacing=0 cellpadding=0 width='100%'>
               <tr><th>Date:</th><td>",$header->get('Date'),"</td></tr>
               <tr><th>De:</th><td>$from</td></tr>
               <tr><th>A:</th><td>$to</td></tr>
               <tr><th>Sujet:</th><td>",$header->get('Subject'),"</td></tr>
          </table>
     </td>
  </tr>
  <tr><td>$body</td></tr>
</table>",end_html;
    }

=item DeleteMsg($Num)

Supprime le message no $num sur le serveur pop, et affiche
la liste des messages actualisés.

=cut

sub DeleteMsg
     {
     my $Num=shift;
     $Client->Delete($Num);
     $Client->Close;
     sleep(1);
     $Client = &Connection;
     &Display;
     $Client->Close();
     }


=item GetHeaders

Recupere la liste des entetes des mails presents. Retourne les
references vers les tableaux \@sub,\@from,\@date,\@to pour
sujet, destinataire, date, emetteur.

=cut

sub GetHeaders
{
     my $i=$start;
     my (@sub,@from,@date,@to);
     my $x=1;
     my @Headers;
     while (($x<11) and ($i<=$Client->Count))
       {
       my $entity = getMailEntity($i);
       $sub[$i]=$entity->head->get('Subject')||'';
       $from[$i]=$entity->head->get('From')||'';
       $date[$i]=$entity->head->get('Date')||'';
       $to[$i]=$entity->head->get('To')||'';
       if ($from[$i]=~/(.*)<([\w\-\.]+\@[\w\-\.]*)>(.*)/) {$from[$i]="$1 <a href=\"mailto:$2\">$2</a> $3";}
       if ($to[$i]=~/(.*)<([\w\-\.]+\@[\w\-\.]*)>(.*)/) {$to[$i]="$1 <a href=\"mailto:$2\">$2</a> $3";}
       $x++;$i++;
       }
     return (\@sub,\@from,\@date,\@to);
}


=item Display($rsub,$rfrom,$rdate,$rto)

Affiche l'ecran HTML avec la liste des messages

=cut

sub Display
     {
     my ($rsub,$rfrom,$rdate,$rto) = GetHeaders();
     my $s=$start;
     my @sub=@$rsub;
     my @from=@$rfrom;
     my @date=@$rdate;
     my @to=@$rto;


     #------- PRINT FROM, SUBJECT, DATE, SIZE, HEADINGS ------#
     print titre($Client->Count." messages to read")."
     <table>
     <tr><td>
     <table width=100%><tr><td>
          <h1>You have a total of ".$Client->Count." messages</h1>
          <a href=\"$homeurl\">Retour</a></td><td align=right>";
     print "<table><tr><td>\n";

     #------- Check Mail button -------#
     print "<FORM METHOD=POST>\n";
     print "<input type='submit' value='Check mail'>\n";
     print "<input type='hidden' name='username' value='$Name'>\n";
     print "<input type='hidden' name='pass' value='$Pass'>\n";
     print "<input type='hidden' name='server' value='$Serv'>\n";
     print "<input type='hidden' name='status' value='Display'>\n";
     print "<input type='hidden' name='start' value='$start'>\n";
     print "</form></td>\n";
     print "<td><form method='POST'><input type='submit' value='Logout'></form></td>\n";
     print "</tr></table> </td></tr></table></td>
     </tr>
     <tr><td>
     <table border=1 cellspacing=0 cellpadding=0><tr>";
     if ($Client->Count>0)
          {
          print "<th>No</th>
                 <th>De</th>
                 <th>Sujet</th>
                 <th>Date</th>
                 <th>Taille</th>
                 <th>Action</th></tr>";
          }
     else {print "<td>Pas de nouvelle, bonne nouvelle</td></tr>";}

     my $c = $start;
     my $x=1;

     while (($x <11) and ($c<=$Client->Count))
     {
          my $styleC;
          if ($c%2) {$styleC="ligne1";}
          else {$styleC="ligne2";}
          print "<tr class=$styleC>
               <td>#$c</td>
               <td>$from[$c]</td>
               <td>$sub[$c]</td>
               <td>$date[$c]</td>\n";
          if ($sizedisplay[$c] > 1023)
               {
               my $messagesize=$sizedisplay[$c] / 1024;
                 print "<td>";
                 printf ("%.1f", $messagesize);
                 print "K</td>\n";
               }
          else { print "<td>1K</td>"; }
          print "<td>",Buttons($c,$styleC), "</td>";
          print "</tr>";
          $c++;                # increment counter
          $x++;
     }

     my $endNo=$c;

     print "</table>\n";
     $Client->Close;
     print "</td></tr></table>\n<table><tr>";

     #------- previous 10 ---------#
     my $prevstart = $start-10;
     if ($prevstart > 0)
          {
          print "<td><form method='POST'>\n";
          print "<input type='submit' value='Prev 10'>\n";
          print "<input type='hidden' name='username' value='$Name'>\n";
          print "<input type='hidden' name='pass' value='$Pass'>\n";
          print "<input type='hidden' name='server' value='$Serv'>\n";
          print "<input type='hidden' name='start' value='$prevstart'>\n";
          print "</form></td>\n";
          }

     #------- Next 10 -------#
     if ($endNo <= $Client->Count)
          {
          print "<td><form method='POST'>\n";
          print "<input type='submit' value='Next 10'>\n";
          print "<input type='hidden' name='username' value='$Name'>\n";
          print "<input type='hidden' name='pass' value='$Pass'>\n";
          print "<input type='hidden' name='server' value='$Serv'>\n";
          print "<input type='hidden' name='start' value='$endNo'>\n";
          print "</form></td>\n";
          }

     print "</tr></table>\n";
     print end_html;
     } #------- End Display soubroutine -------#


=item getMailEntity($num)

Recupere le mail no $num, et retourne un object MIME::Head

=cut

sub getMailEntity
     {
     my $Num=shift;
     my $bod = $Client->HeadAndBody($Num);
     my $parser = new MIME::Parser;
     $parser->output_to_core(1);
     my $entity = $parser->parse_data($bod);
     #$entity->print(\*STDOUT);
     return $entity;
     }

=item Buttons($c,$style)

Affiche le code HTML des boutons "back" "read" "next" "next>>" "<<previous"

=cut

sub Buttons
{
     my ($c,$style)=@_;
     my $buf;
     if (!$style) {$style=' ';}
     $buf.= "
<form method='POST'>
  <input type='hidden' name='username' value=$Name>
  <input type='hidden' name='pass' value='$Pass'>
  <input type='hidden' name='server' value='$Serv'>
  <input type='hidden' name='Num' value='$c'>
  <input type='hidden' name='start' value='$start'>
<table border=0 cellspacing=0 cellpadding=0 class=$style><tr>\n";

     if (param('status') and (param('status') eq "Read"))
       {
        $buf.="<td><input type='submit' name='status' value='Back'></td>\n"; # Back button
        if ($c > 1) # << Previous
          {$buf.="<td><input type='submit' name='Read' value='<< Previous'></td>\n";}
        if ($c < $Client->Count) # Next >>
          {$buf.="<td><input type=submit name='Read' value='Next >>'></td>\n";}
       }
     else # Read button
       {$buf.="<td><input type='Submit' name='status' value='Read'></td>\n";}
     # Delete button
     $buf.="<td><input type='submit' name='status' value='Delete'></td>
     </tr>\n</table>\n</form>\n";

     return $buf;
}

=item Connection

Etablit la connection avec le serveur POP3. Retourne un object de 
type Mail::POP3Client si cree, sinon die en signalant l'erreur

=cut

sub Connection
     {
     $Client = new Mail::POP3Client(USER=>$Name,PASSWORD=>$Pass,TIMEOUT=>10,HOST=>$Serv);
     for (my $d=1; $d<=$Client->Count; $d++)
       {($d, $sizedisplay[$d]) = split ' ', $Client -> List( $d );}
     # Check for correct username and password
     if ($Client->State eq "AUTHORIZATION")
          {
          print titre('POP Services : Invalid username or password').
          "<table><tr><td>".
            h1("Please verify that you are using the correct username and password").
          "<a href=\"$ENV{'HTTP_REFERER'}\">Return to login screen</a>".
          "</td></tr></table>",$Client->Message();
          exit(0);
          }
     # Check to see if valid pop3 server
     elsif ($Client->State eq "DEAD")
          {
          print titre('POP Services :  Invalid server').
          "<table><tr><td>".
            h1("The server you entered is invalid. Try again").
          "<a href=\"$ENV{'HTTP_REFERER'}\">Return to login screen</a>".
          "</td></tr></table>",$Client->Message();
          exit(0);
          }
     return $Client;
     }

=back

=cut