#! /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 $userAgent = $ENV{HTTP_USER_AGENT}; my $remoteIP = $ENV{REMOTE_ADDR}; my $hostname = $ENV{'SERVER_NAME'}; sub ValidCookie { my $clientLoginCookie = shift; if (not defined $clientLoginCookie){ return; } my $dir = shift; my $filename = $clientLoginCookie->value; my $loginCookieFile = "$dir/$filename.txt"; if ($filename =~ /^([\w]+)$/){ $filename = $1; } else{ return; } if (-e $loginCookieFile){ open my $in, '<', $loginCookieFile or die "can't read file: $!"; my $remoteIPLine = readline $in; my $userAgentLine = readline $in; my $cookieLine = readline $in; close $in; chomp ($remoteIPLine, $userAgentLine); if (not defined $cookieLine){ return; } my %magicCookie = CGI::Cookie->parse($cookieLine) or die "$!"; my $magicCookieValue = $magicCookie{'id'}->value; my $remoteIPMatch = $remoteIPLine cmp $remoteIP; my $userAgentMatch = $userAgentLine cmp $userAgent; my $magicCookieMatch = $magicCookieValue cmp $clientLoginCookie->value; if ($remoteIPMatch == 0 and $userAgentMatch == 0 and $magicCookieMatch == 0){ return 1; } } else{ return; } return; } sub LoginCookieGen { my $IDCookie = shift; my $dir = shift; if (not defined $IDCookie){ if (not -d "$dir"){ mkpath("$dir") or die "$!"; } my $StrRandObj = String::Random->new; my $val = $StrRandObj->randregex('\w{64}'); my $cookieFile = "$dir/$val.txt"; my $newLoginCookie = 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 "$remoteIP\n$userAgent\n$newLoginCookie"; close $out; print "Set-Cookie: $newLoginCookie\n"; } } sub UntaintCGIFilename { my $filename = shift; if ($filename =~ /^([-\@\w.\/]+)$/) { $filename = $1; } else { die "$!"; } chomp $filename; return $filename; } sub GetRFC822Date { use POSIX qw(strftime locale_h); my $oldLocale = setlocale(LC_TIME, "C"); my $date = strftime("%a, %d %b %Y %H:%M:%S %z", localtime(time())); setlocale(LC_TIME, $oldLocale); return $date; } sub SendGpigeonMail { my ($recipient, $title, $message) = @_; use Net::SMTP; use Net::SMTPS; use MIME::Entity; my $RFC822Date = GetRFC822Date() or die; my $HasMailserver = q{has_mailserver_goes_here}; my $mailSender = q{sender_addr_goes_here}; my $mailSenderSMTP = q{smtp_domain_goes_here}; my $mailSenderPort = q{smtp_port_goes_here}; my $mailSenderPassword = q{sender_pw_goes_here}; my $smtp = undef; if ($HasMailserver){ $smtp = Net::SMTP->new(Host => 'localhost') or die; } else { $smtp = Net::SMTPS->new($mailSenderSMTP, Port => $mailSenderPort, doSSL => 'ssl', Debug_SSL => 0); $smtp->auth($mailSender, $mailSenderPassword) or die; } my $notifyLinkByMailData = MIME::Entity->build( Date => $RFC822Date, From => $mailSender, To => $recipient, Charset => 'utf-8', Subject => $title, Data => [$message] ) or die; $smtp->mail($mailSender) or die "Net::SMTP module has broke: $!."; if ($smtp->to($recipient)){ $smtp->data($notifyLinkByMailData->stringify); $smtp->dataend(); $smtp->quit(); } else { die $smtp->message(); } } my ( $linkAsker, $checkedOrNot, $hiddenPasswordField, $IDCookie, $deleteIDCookie, $IDCookieValue, $refreshForm) = undef; my $linkGenNotif = my $mailIsOkNotif = my $deletionNotif = my $loginNotif = my $sentMailNotif = ''; my @createdLinks = (); my $argon2idHash = qq{argon2idHash_goes_here}; my $cookiesDir = q{cookiesDir_goes_here}; my $linkTemplatePath = q{linkTemplatePath_goes_here}; my %textStrings = ( addr => 'Address', addr_ok => 'is valid!', addr_nok => 'is not valid !', addr_unknown => 'Unknown', create_link_btn => 'Generate link', checkbox_notiflinkbymail => 'Notify the user by mail about the link', delete_link_btn_text => 'Delete', delete_links_btn_text => 'Delete all links', here => 'here', landingpage_title => 'GPIGEON - Login', linkAsker_field_label => '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 $CGIQueryGet = CGI->new; my $password = $CGIQueryGet->param('password'); my $logout = $CGIQueryGet->param('logout'); my %currentCookies = CGI::Cookie->fetch; $IDCookie = $currentCookies{'id'}; if (not defined $IDCookie){ $hiddenPasswordField = qq{}; $refreshForm = qq{
$hiddenPasswordField
}; } else{ $hiddenPasswordField = ''; $refreshForm = qq{
}; $IDCookieValue = $IDCookie->value; if ($IDCookieValue =~ /^([\w]+)$/){ $IDCookieValue = $1; } if ($logout){ $deleteIDCookie = CGI::Cookie->new( -name => 'id', -value => $IDCookieValue, -expires => '-1d', '-max-age' => '-1d', -domain => ".$hostname", -path => '/', -secure => 1, -httponly => 1, -samesite => 'Strict', ); my $f = "$cookiesDir/$IDCookieValue.txt"; if (-e "$f"){ unlink "$f" or die "Can't delete file :$!"; } print "Set-Cookie: $deleteIDCookie\n"; } } print "Cache-Control: no-store, must-revalidate\n"; if (ValidCookie($IDCookie, $cookiesDir) or argon2id_verify($argon2idHash,$password)){ LoginCookieGen($IDCookie, $cookiesDir); if (defined $CGIQueryGet->param('supprlien')){ my $pendingDeletion = $CGIQueryGet->param('supprlien'); my $linkFileFilename = "./l/$pendingDeletion"; if (unlink UntaintCGIFilename($linkFileFilename)){ $deletionNotif = qq{$textStrings{link_del_ok}}; } else { $deletionNotif = qq{$textStrings{link_del_failed} $linkFileFilename : $!}; } } if (defined $CGIQueryGet->param('supprtout')){ rmtree('./l', {keep_root => 1, safe => 1}); $deletionNotif = qq{$textStrings{link_del_ok}}; } if (defined $CGIQueryGet->param('mail')){ $linkAsker = scalar $CGIQueryGet->param('mail'); if ( Email::Valid->address($linkAsker) ){ $mailIsOkNotif = qq{$textStrings{addr} $linkAsker $textStrings{addr_ok}}; my $StrRandObj = String::Random->new; my $generatedFormFilename = $StrRandObj->randregex('\w{64}') . '.cgi'; my $hrefLink = "https://$hostname/cgi-bin/l/$generatedFormFilename"; my $linkPath = "./l/$generatedFormFilename"; open my $in, '<', $linkTemplatePath or die "Can't read link template file: $!"; open my $out, '>', $linkPath or die "Can't write to link file: $!"; while( <$in> ) { s/{link_user}/{$linkAsker}/g; print $out $_; } close $in or die; chmod(0755,$linkPath) or die; close $out or die; $linkGenNotif = qq{$textStrings{link_ok_for} $linkAsker:
$href}; if (defined $CGIQueryGet->param('notiflinkbymail')){ SendGpigeonMail($linkAsker,"[GPIGEON](Do not reply) Your encrypted form is ready","Greetings,\n\n\tAn encrypted form has been generated for you on $hostname.\n\tClick on the link below to fill in the form:\n\t$hrefLink\n\tIf you believe this mail is not meant for you, ignore it and mail the webmaster or admin about it.\n\nKind regards,\nGpigeon mailing system at $hostname.") or $sentMailNotif="$!" ; } } else{ $mailIsOkNotif = qq{$textStrings{addr} $linkAsker $textStrings{addr_nok}.}; } } opendir my $linkDirHandle, './l' or die "Can't open ./l: $!"; while (readdir $linkDirHandle) { if ($_ ne '.' and $_ ne '..'){ my $linkFileFilename = $_; my $linkFileStats = stat("./l/$linkFileFilename"); my $linkCreationDate = scalar localtime $linkFileStats->mtime; if (open my $linkFileHandle , '<', "./l/$linkFileFilename"){ for (1..2){ $linkAsker = readline $linkFileHandle; $linkAsker =~ s/q\{(.*?)\}//i; $linkAsker = $1; } close $linkFileHandle; if (Email::Valid->address($linkAsker)){ push @createdLinks, qq{ $textStrings{here} $linkAsker $linkCreationDate
$hiddenPasswordField
}; } } else { close $linkFileHandle; die 'Content-type: text/plain', "\n\n", "Error: Can't open $linkFileFilename: $!"; } } } closedir $linkDirHandle; print 'Content-type: text/html',"\n\n", qq{ $textStrings{mainpage_title}

$textStrings{mainpage_title}

$textStrings{web_greet_msg}

$refreshForm

$hiddenPasswordField $textStrings{linkAsker_field_label}
$linkGenNotif
$hiddenPasswordField
$deletionNotif @createdLinks
🔗 $textStrings{theader_link} 📧 $textStrings{theader_for} 📅 $textStrings{theader_cdate} ❌ $textStrings{theader_deletion}
}; } else{ if (not $logout and defined $IDCookie){ $loginNotif = q{You got a cookie problem.
Clean them and log again
}; } if (length($password) > 0){ $loginNotif = q{Your typed password seems
to be incorrect.
Try again.
}; } print "Content-type: text/html\n\n", qq{ $textStrings{landingpage_title}

$textStrings{landingpage_title}

Password :
$loginNotif

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

}; }