#! /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{
$hidden_pwfield
}; } 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{ $text_strings{here} $link_asker $linkcdate
$hidden_pwfield
}; } } else { close $linkfile_handle; die 'Content-type: text/plain', "\n\n", "Error: Can't open $linkfile_fn: $!"; } } } closedir $link_dir_handle; print 'Content-type: text/html',"\n\n", qq{ $text_strings{mainpage_title}

$text_strings{mainpage_title}

$text_strings{web_greet_msg}

$refresh_form

$hidden_pwfield $text_strings{link_asker_field_label}
$mailisok_notif
$linkgen_notif
$hidden_pwfield
$deletion_notif 🔗 $text_strings{theader_link} 📧 $text_strings{theader_for} 📅 $text_strings{theader_cdate} ❌ $text_strings{theader_deletion} @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}

$text_strings{landingpage_title}

Password :
$login_notif

Source code here. It is similar to hawkpost.co.

}; }