1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
#! /usr/bin/perl -T
# link-tmpl.cgi : self-destructing message form to send yourself GPG
# encrypted messages. Part of gpigeon.
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <https://www.gnu.org/licenses/>.
# Copyright (c) 2020-2021, Miquel Lionel <lionel@les-miquelots.net>
my $linkuser = q{link_user};
use warnings;
use strict;
use CGI qw(param);
delete @ENV{qw(IFS PATH CDPATH BASH_ENV)};
$ENV{'PATH'}=q{bin_path_goes_here};
$ENV{TMPDIR}=q{tmp_dir_goes_here};
sub GetRFC822Date {
# https://stackoverflow.com/a/40149475, Daniel VÃritÃ
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 $mailaddr = q{user_mailaddr_goes_here};
my $mailsender = q{sender_addr_goes_here};
my $mailsender_smtp = q{smtp_domain_goes_here};
my $mailsender_port = q{smtp_port_goes_here};
my $mailsender_pw = q{sender_pw_goes_here};
my $GPG_HOMEDIR = q{gpg_homedir_goes_here};
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) = undef;
my $form_error_notif = '<!-- undef notif -->';
my $max_mb = 100;
$CGI::POST_MAX = 1024*1024*$max_mb; # 100MBytes
my $fupload_limit = $CGI::POST_MAX;
if (defined $length_msg_form and $length_msg_form > $msg_form_char_limit){
$form_error_notif = qq{<span id="failure"><b>Cannot send message : message length must be under $msg_form_char_limit characters.</b></span>};
}
elsif (defined $length_msg_form and $length_msg_form eq 0 ){
$form_error_notif = qq{<span id="failure"><b>Cannot send message : message is empty. You can type up to $msg_form_char_limit characters.</b></span>};
}
else {
if (defined $length_msg_form and $ENV{REQUEST_METHOD} eq 'POST'){
$msg_form =~ tr/\r//d; # if we dont do this, ^M character in plain text mail will show up
use Mail::GPG;
my $gpgmail = Mail::GPG->new(
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,
Subject => '.',
To => $mailaddr,
Data => [ "This is a message from $linkuser:\n\n$msg_form" ],
Charset => 'utf-8',
);
if ( my $fh = $cgi_query_get->upload('fupload') ){
my $fullfn = $cgi_query_get->param('fupload');
$fullfn =~ s/[^A-Za-z_0-9\.\-]/_/g;
$fullfn =~ s/__+/_/g;
my $fpath = $cgi_query_get->tmpFileName($fh) or die "can't get uploaded file name: $!";
my $fsize = -s $fpath;
if ($fsize > $fsize_limit){
die 'ERROR: File is too big (>100MB).'; # I don't think we'll se this error, it'll return 413 instead
}
my $mimetype = $cgi_query_get->uploadInfo($fh)->{'Content-Type'};
if (not $mimetype =~ /^([\w]+)\/([\w]+)$/){
die "Unrecognized MIME type";
}
$mimentity->attach(
Type => $mimetype,
Description => $fullfn,
Encoding => 'base64',
Path => $fpath,
Filename => $fullfn,
) or die "can't attach file to main MIME entity: $!";
}
my $encrypted_mime_blob = $gpgmail->mime_encrypt(entity => $mimentity);
my $encrypted_mime = $encrypted_mime_blob->as_string;
use Net::SMTP;
use Net::SMTPS;
if ($HAS_MAILSERVER){
$smtp = Net::SMTP->new(Host => 'localhost');
}
else {
$smtp = Net::SMTPS->new($mailsender_smtp, Port => $mailsender_port, doSSL => 'ssl', Debug_SSL => 0);
$smtp->auth($mailsender, $mailsender_pw) or die "$!";
}
$smtp->mail($mailsender) or die "Net::SMTP module has broke: $!.";
if ($smtp->to($mailaddr)){
$smtp->data($encrypted_mime);
$smtp->dataend();
$smtp->quit();
}
else {
die $smtp->message();
}
if ($0 =~ /([\w]+)\.cgi$/){
unlink "$1.cgi";
}
print "Location: /merci/index.html\n\n";
}
}
print "Content-type: text/html", "\n\n",
qq{<!DOCTYPE html>
<html>
<head>
<link rel="icon" sizes="48x48" type="image/ico" href="/favicon.ico">
<link rel="stylesheet" type="text/css" href="/styles.css">
<meta http-equiv="Content-Type" content="text/html;charset=UTF-8">
<meta charset="UTF-8">
<title>GPIGEON - Message form</title>
</head>
<body>
<p id="msgbelow">Type your message below:</p>
<form method="POST" enctype="multipart/form-data">
<textarea id="msg" wrap="off" cols="50" rows="30" name="msg"></textarea><br>
$form_error_notif
<label for="filechoice" id="msgbelow">
(Optional) file upload:
<input id="filechoice" type="file" name="file">
</label>
<input id="sendbtn" type="submit" value="Send">
</form>
</body>
</html>};
|
