#! /usr/bin/perl -T
# gpigeon.cgi: generate links for someone to send you GPG encrypted messages via a one time form.
# 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 .
# Copyright (c) 2020-2021, Miquel Lionel
use warnings;
use strict;
use File::Path qw(mkpath rmtree);
use File::stat;
use Email::Valid;
use String::Random;
use Crypt::Argon2 qw(argon2id_verify);
use CGI qw(param);
use CGI::Cookie;
use CGI::Carp qw(fatalsToBrowser);
delete @ENV{qw(IFS PATH CDPATH BASH_ENV)};
$ENV{'PATH'} = q{bin_path_goes_here};
my $uagent = $ENV{HTTP_USER_AGENT};
my $rIP = $ENV{REMOTE_ADDR};
my $hostname = $ENV{'SERVER_NAME'};
sub ValidCookie {
my $client_login_cookie = shift;
if (not defined $client_login_cookie){
return;
}
my $dir = shift;
my $filename = $client_login_cookie->value;
my $login_cookiefile = "$dir/$filename.txt";
if ($filename =~ /^([\w]+)$/){
$filename = $1;
}
else{
return;
}
if (-e $login_cookiefile){
open my $in, '<', $login_cookiefile or die "can't read file: $!";
my $rip_line = readline $in;
my $ua_line = readline $in;
my $cookie_line = readline $in;
close $in;
chomp ($rip_line, $ua_line);
if (not defined $cookie_line){
return;
}
my %magic_cookie = CGI::Cookie->parse($cookie_line) or die "$!";
my $magic_cookie_val = $magic_cookie{'id'}->value;
my $rip_match = $rip_line cmp $rIP;
my $ua_match = $ua_line cmp $uagent;
my $magic_match = $magic_cookie_val cmp $client_login_cookie->value;
if ($rip_match == 0 and $ua_match == 0 and $magic_match == 0){
return 1;
}
}
else{
return;
}
return;
}
sub LoginCookieGen {
my $id_cookie = shift;
my $dir = shift;
if (not defined $id_cookie){
if (not -d "$dir"){
mkpath("$dir") or die "$!";
}
my $str_rand_obj = String::Random->new;
my $val = $str_rand_obj->randregex('\w{64}');
my $cookiefile = "$dir/$val.txt";
my $new_login_cookie = CGI::Cookie->new(
-name => 'id',
-value => $val,
-expires => '+1y',
'-max-age' => '+1y',
-domain => ".$hostname",
-path => '/',
-secure => 1,
-httponly => 1,
-samesite => 'Strict',
) or die "Can't create cookie: $!";
open my $out, '>', $cookiefile or die "Can't write to $cookiefile: $!";
print $out "$rIP\n$uagent\n$new_login_cookie";
close $out;
print "Set-Cookie: $new_login_cookie\n";
}
}
sub UntaintCGIFilename {
my $filename = shift;
if ($filename =~ /^([-\@\w.\/]+)$/) {
$filename = $1;
}
else {
die "$!";
}
chomp $filename;
return $filename;
}
my ( $link_asker, $checkedornot, $hidden_pwfield, $id_cookie,
$delete_id_cookie, $idval, $refresh_form) = undef;
my $linkgen_notif = my $mailisok_notif = my $deletion_notif = my $login_notif = '';
my @created_links = ();
my $argon2id_hash = qq{argon2id_hash_goes_here};
my $cookies_dir = q{cookies_dir_goes_here};
my $link_template_path = q{link_template_path_goes_here};
my %text_strings = (
addr => 'Address',
addr_ok => 'is valid!',
addr_nok => 'is not valid !',
addr_unknown => 'Unknown',
create_link_btn => 'Generate link',
delete_link_btn_text => 'Delete',
delete_links_btn_text => 'Delete all links',
here => 'here',
landingpage_title => 'GPIGEON - Login',
link_asker_field_label => q{Asker's mail :},
link_del_ok => 'Successful removal !',
link_ok_for => 'Generated a link for',
link_del_failed => 'Deletion failed and here is why : ',
loginbtn => 'Log in',
logout_btn_text => 'Logout',
mailto_body => 'Your link is ',
mailto_subject => 'Link to your one time GPG messaging form',
mainpage_title => 'GPIGEON - Main',
notif_login_failure => 'Cannot login. Check if your username and password match.',
refresh_btn_text => 'Refresh',
theader_link => 'Link',
theader_for => 'For',
theader_deletion => 'Deletion',
theader_cdate => 'Created on',
web_greet_msg => 'Hi and welcome.',
);
my $cgi_query_get = CGI->new;
my $pw = $cgi_query_get->param('password');
my $logout = $cgi_query_get->param('logout');
my %cur_cookies = CGI::Cookie->fetch;
$id_cookie = $cur_cookies{'id'};
if (not defined $id_cookie){
$hidden_pwfield = qq{};
$refresh_form = qq{};
}
else{
$hidden_pwfield = '';
$refresh_form = qq{};
$idval = $id_cookie->value;
if ($idval =~ /^([\w]+)$/){
$idval = $1;
}
if ($logout){
$delete_id_cookie = CGI::Cookie->new(
-name => 'id',
-value => $idval,
-expires => '-1d',
'-max-age' => '-1d',
-domain => ".$hostname",
-path => '/',
-secure => 1,
-httponly => 1,
-samesite => 'Strict',
);
my $f = "$cookies_dir/$idval.txt";
if (-e "$f"){
unlink "$f" or die "Can't delete file :$!";
}
print "Set-Cookie: $delete_id_cookie\n";
}
}
print "Cache-Control: no-store, must-revalidate\n";
if (ValidCookie($id_cookie, $cookies_dir) or argon2id_verify($argon2id_hash,$pw)){
LoginCookieGen($id_cookie, $cookies_dir);
if (defined $cgi_query_get->param('supprlien')){
my $pending_deletion = $cgi_query_get->param('supprlien');
my $linkfile_fn = "./l/$pending_deletion";
if (unlink UntaintCGIFilename($linkfile_fn)){
$deletion_notif = qq{$text_strings{link_del_ok}};
}
else {
$deletion_notif = qq{$text_strings{link_del_failed} $linkfile_fn : $!};
}
}
if (defined $cgi_query_get->param('supprtout')){
rmtree('./l', {keep_root => 1, safe => 1});
$deletion_notif = qq{$text_strings{link_del_ok}};
}
if (defined $cgi_query_get->param('mail')){
$link_asker = scalar $cgi_query_get->param('mail');
if ( Email::Valid->address($link_asker) ){
$mailisok_notif = qq{$text_strings{addr} $link_asker $text_strings{addr_ok}};
my $str_rand_obj = String::Random->new;
my $generated_form_filename = $str_rand_obj->randregex('\w{64}') . '.cgi';
my $href = "https://$hostname/cgi-bin/l/$generated_form_filename";
my $link_path = "./l/$generated_form_filename";
open my $in, '<', $link_template_path or die "Can't read link template file: $!";
open my $out, '>', $link_path or die "Can't write to link file: $!";
while( <$in> ) {
s/{link_user}/{$link_asker}/g;
print $out $_;
}
close $in or die;
chmod(0755,$link_path) or die;
close $out or die;
$linkgen_notif = qq{$text_strings{link_ok_for} $link_asker: $href};
}
else{
$mailisok_notif = qq{$text_strings{addr} $link_asker $text_strings{addr_nok}.};
}
}
opendir my $link_dir_handle, './l' or die "Can't open ./l: $!";
while (readdir $link_dir_handle) {
if ($_ ne '.' and $_ ne '..'){
my $linkfile_fn = $_;
my $linkstats = stat("./l/$linkfile_fn");
my $linkcdate = scalar localtime $linkstats->mtime;
if (open my $linkfile_handle , '<', "./l/$linkfile_fn"){
for (1..2){
$link_asker = readline $linkfile_handle;
$link_asker =~ s/q\{(.*?)\}//i;
$link_asker = $1;
}
close $linkfile_handle;
if (Email::Valid->address($link_asker)){
push @created_links,
qq{
@created_links
};
}
else{
if (not $logout and defined $id_cookie){
$login_notif = q{You got a cookie problem. Clean them and log again};
}
if (length($pw) > 0){
$login_notif = q{Your typed password seems
to be incorrect. Try again.};
}
print "Content-type: text/html\n\n",
qq{
$text_strings{landingpage_title}