From 8a833dde23b0bbcf74643cc04e52165c63606e83 Mon Sep 17 00:00:00 2001
From: Miquel Lionel <lionel@les-miquelots.net>
Date: Thu, 15 Jul 2021 19:26:38 +0100
Subject: uncomment my $mimetype line, it's important.

    Also, we did a better cleanup:
        - GPG module is not used anymore. So, the $enc_gpg variable doesn't make
        sense anymore and we got rid of it.
        - We applied the auto unlinking we did in the database version branch.
        I was sure I already put to pratice on this branch, my memory fails me...
        Got rid of $linkfilename variable.
        - We updated the README.md about our dependencies and features (file upload
        is supported now)
---
 link-tmpl-template.cgi | 38 +++++++++++++++++++++++++++-----------
 1 file changed, 27 insertions(+), 11 deletions(-)

(limited to 'link-tmpl-template.cgi')

diff --git a/link-tmpl-template.cgi b/link-tmpl-template.cgi
index 49e5b47..94530ae 100644
--- a/link-tmpl-template.cgi
+++ b/link-tmpl-template.cgi
@@ -1,4 +1,4 @@
-#! /usr/bin/perl -wT
+#! /usr/bin/perl -T
 my $linkuser = q{link_user};
 # link-tmpl.cgi : self-destructing message form to send yourself GPG
 # encrypted messages. Part of gpigeon.
@@ -26,10 +26,21 @@ delete @ENV{qw(IFS PATH CDPATH BASH_ENV)};
 $ENV{'PATH'}="/usr/bin";
 $ENV{TMPDIR} = q{tmp_dir_goes_here};
 
+sub GetRFC822Date {
+    # https://stackoverflow.com/a/40149475, Daniel VÃrité, 4 lines
+    use POSIX qw(strftime locale_h);
+    my $old_locale = setlocale(LC_TIME, "C");
+    my $date = strftime("%a, %d %b %Y %H:%M:%S %z", localtime(time()));
+    setlocale(LC_TIME, $old_locale);
+
+    return $date;
+}
+
 my $HAS_MAILSERVER = q{has_mailserver_goes_here};
 my $msg_form_char_limit = q{msg_char_limit_goes_here};
-my $mymailaddr = q{your_addr_goes_here};
-my $mymail_gpgid = q{gpgid_goes_here}; #0xlong keyid form
+my $max_mb = q{100};
+my $mailaddr = q{your_addr_goes_here};
+my $mail_gpgid = q{gpgid_goes_here}; #0xlong keyid form
 my $mailsender = q{sender_addr_goes_here};
 my $mailsender_smtp = q{smtp_domain_goes_here};
 my $mailsender_port = q{smtp_port_goes_here};
@@ -39,6 +50,7 @@ my $cgi_query_get = CGI->new;
 my $msg_form = $cgi_query_get->param('msg');
 my $length_msg_form = length $msg_form;
 my ($smtp, $enc_msg, $error_processing_msg) = undef;
+$CGI::POST_MAX = 1024*1024*$max_mb; # 100Mo limit
 
 if (defined $length_msg_form and $length_msg_form > $msg_form_char_limit){
     $error_processing_msg = qq{<span id="failure"><b>Cannot send message : message length must be under $msg_form_char_limit characters.</b></span>};
@@ -52,12 +64,15 @@ else {
         use Mail::GPG;
         $msg_form =~ tr/\r//d;
         my $gpgmail  = Mail::GPG->new(
-            default_key_id => $mymailaddr,
+            default_key_encrypt => $mailaddr,
+            default_key_id => $mailaddr,
             gnupg_hash_init => {homedir => $GPG_HOMEDIR},
             debug => 0,
             no_strict_7bit_encoding => 1,
         );
+        my $rfc822date = GetRFC822Date();
         my $mimentity = MIME::Entity->build(
+            Date => $rfc822date,
             From => $mailsender,
             To => $mailaddr,
             Subject => '.',
@@ -65,23 +80,22 @@ else {
             Charset => 'utf-8',
         );
         
-        $enc_msg = $gpg->encrypt("$linkuser:\n\n$msg_form", $mymail_gpgid) or die $gpg->error();
-
         if (my $fh = $cgi_query_get->upload('file')){
             my $fullfn = $cgi_query_get->param('file');
             $fullfn =~ s/^[a-zA-Z_0-9\-\.]/_/g;
             $fullfn =~ s/__+/_/g;
             my $fpath = $cgi_query_get->tmpFileName( $fh );
             my $fsize = -s $fpath;
-            $CGI::POST_MAX = 1024*1024*100; # 100Mo limit
+            
             if ($fsize > $CGI::POST_MAX){
                 die 'ERROR: File is too big (>100MB).';
             }
-#           my $mimetype = $cgi_query_get->uploadInfo( $fh )->{'Content-Type'};
-#           my $lengthf = $cgi_query_get->uploadInfo( $fh )->{'Content-Length'};
+
+            my $mimetype = $cgi_query_get->uploadInfo( $fh )->{'Content-Type'};
             if (not $mimetype =~ /^([\w]+)\/([\w]+)$/){
                 die 'Unrecognized MIME type of uploaded file.';
             }
+
             $mimentity->attach(
                 Type => $mimetype,
                 Description => 'OpenPGP encrypted attachment',
@@ -107,7 +121,7 @@ else {
             $smtp->auth($mailsender, $mailsender_pw) or die;
         }
         $smtp->mail($mailsender) or die "Net::SMTP module has broke: $!.";
-        if ($smtp->to($mymailaddr)){
+        if ($smtp->to($mailaddr)){
             $smtp->data($puremime);
             $smtp->dataend();
             $smtp->quit();
@@ -116,7 +130,9 @@ else {
             die $smtp->message();
         }
 
-        unlink $linkfilename;
+        if ($0 =~ /([\w]+)\.cgi$/){
+            unlink "$1.cgi";
+        }
         print "Location: /merci/index.html\n\n"; 
     }
 }
-- 
cgit v1.2.3-70-g09d2