#! /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-2022, Miquel Lionel
use warnings;
use strict;
use Email::Valid;
use String::Random;
use DBI;
use CGI qw(param);
use CGI::Cookie;
use CGI::Carp qw(fatalsToBrowser);
use Crypt::Argon2 qw(argon2id_verify);
use File::Path qw(mkpath rmtree);
use File::stat;
delete @ENV{qw(IFS PATH CDPATH BASH_ENV)};
$ENV{'PATH'} = q{/usr/bin};
my $hostname = $ENV{'SERVER_NAME'};
my $remoteIP = $ENV{REMOTE_ADDR};
my $userAgent = $ENV{HTTP_USER_AGENT};
my %textStrings = (
addr => 'Address',
addr_ok => 'is valid!',
addr_nok => 'is not valid !',
addr_unknown => 'Unknown',
create_link_btn => 'Create link',
create_invite_btn => 'Create invite',
cookie_problems => 'You got a cookie problem. Clean them and log in again',
checkbox_admin_user => 'User will be an admin',
checkbox_notiflinkbymail => 'Notify the user by mail about the link',
checkbox_invite_mailnotif => 'Send login details via an encrypted mail once the form is completed',
checkbox_mailinvite => 'Send mail about the invite',
optmail => '(Optional) Mail :',
delete_link_btn_text => 'Delete',
delete_links_btn_text => 'Delete all links',
delete_invites_btn_text => 'Delete all invites',
disconnect_btn_text => 'Disconnect',
logout_btn_text => 'Logout',
here => 'here',
landingpage_title => 'GPIGEON - Log in',
loginbtn => 'Log in',
linkAsker_field_label => "Asker's mail :",
link_del_ok => 'Successful removal !',
link_legend_textarea => 'Type your message below :',
link_ok_for => 'Generated a link for',
link_del_failed => 'Deletion failed and here is why : ',
link_generated_ok => "Success! Here's the link",
mailto_body => 'Your link is ',
mailto_subject => 'Link to your one time GPG messaging form',
incorrect_ids => 'Username/password combination is incorrect. Try again.',
password_label => 'Password :',
refresh_btn => 'Refresh',
theader_link => 'Link',
theader_for => 'For',
theader_deletion => 'Deletion',
theader_creationdate => 'Created on',
username_label => 'Username :',
web_title => 'GPIGEON - Main',
web_greet_msg => 'Hi and welcome. What will you do today ?',
);
sub GetFileTable {
my ($dir ,$hiddenLoginField, $adminPanelField) = @_;
my @table = ();
opendir my $linkDirHandle, "$dir" or die "Can't open $dir: $!";
while (readdir $linkDirHandle) {
if ($_ ne '.' and $_ ne '..'){
my $pendingDeletion = $_;
my $linkFileStats= stat("$dir/$pendingDeletion");
my $time = scalar localtime $linkFileStats->mtime;
my $linkAsker = undef;
if (open my $linkFileHandle , '<', "$dir/$pendingDeletion"){
for (1..2){
$linkAsker = readline $linkFileHandle;
$linkAsker =~ s/q\{(.*?)\}//i;
$linkAsker = $1;
}
close $linkFileHandle;
my $forFieldBody = qq{$linkAsker};
if (not defined $linkAsker){
$forFieldBody = $textStrings{addr_unknown};
}
#create links table html
push @table,
qq{
};
}
else {
close $linkFileHandle;
die 'Content-type: text/plain', "\n\n", "Error: Can't open $pendingDeletion: $!";
}
}
}
closedir $linkDirHandle;
return @table;
}
sub DbGetLine {
my ($dbh, $query) = @_;
my $prep = $dbh->prepare( $query );
my $exec = $prep->execute() or die $DBI::errstr;
if ($exec < 0){
print $DBI::errstr;
}
while (my @rows = $prep->fetchrow_array()) {
my $row = $rows[0];
return $row;
}
}
sub LoginOk {
my ($dbh, $username, $pass, $userID, $magicCookie, $UIDCookie, $cookiesDir) = @_;
my $loginsuccess = PasswdLogin($dbh, $username, $pass);
if (not defined $loginsuccess){
$loginsuccess = CookieLogin($userID, $magicCookie, $UIDCookie, $cookiesDir);
}
return $loginsuccess;
}
sub ListUsers {
my ($dbh) = shift;
my @usersTable = ();
my $prep = $dbh->prepare(q{SELECT name,mail from pigeons;} );
my $exec = $prep->execute() or die $DBI::errstr;
if ($exec < 0){
print $DBI::errstr;
}
while (my @rows = $prep->fetchrow_array()) {
#print "$rows[0]\t$rows[1]\n";
push @usersTable,
qq{
$rows[0]
$rows[1]
};
}
return @usersTable;
}
sub CookieLogin {
my ($userID, $magicCookie, $UIDCookie, $cookiesDir) = @_;
if (not $userID =~ /^([0-9]+)$/){
return;
}
if (not defined $magicCookie or not defined $UIDCookie){
return;
}
my ($remoteIPLine, $UserAgentLine, $IDLine, $UIDLine) = undef;
my $filename = $magicCookie->value;
if ($filename =~ /^([\w]+)$/){
$filename = $1;
}
else{
return;
}
my $loginCookieFile = "$cookiesDir/$userID/$filename.txt";
if (-e $loginCookieFile){
open my $in, '<', $loginCookieFile or die "can't read file: $!";
$remoteIPLine = readline $in;
$UserAgentLine = readline $in;
$IDLine = readline $in;
$UIDLine = readline $in;
close $in;
chomp ($remoteIPLine, $UserAgentLine, $IDLine); # chomp the \n
}
else{
return;
}
my %IDLineCookie = CGI::Cookie->parse($IDLine);
my %UIDLineCookie = CGI::Cookie->parse($UIDLine);
my $IDValue = $IDLineCookie{'id'}->value;
my $UIDValue = $UIDLineCookie{'uid'}->value;
my $IPMatch = $remoteIPLine cmp $remoteIP;
my $UserAgentMatch = $UserAgentLine cmp $userAgent;
my $UIDMatch = $UIDCookie->value cmp $UIDValue;
my $IDMatch = $magicCookie->value cmp $IDValue;
if ($IPMatch == 0 and $UserAgentMatch == 0 and $UIDMatch == 0 and $IDMatch == 0){
return $userID;
}
return;
}
sub PasswdLogin {
my ($dbh, $username, $pass) = @_;
if (not defined $username or not defined $pass){
return;
}
if (not Email::Valid->address($username)){
if ($username =~ /^([-\w.]+)$/) {
$username = $1;
} else {
return;
}
}
my ($hash, $userID) = undef;
my $selectHash = qq{SELECT pass from pigeons where mail='$username' or name='$username';};
$hash = DbGetLine($dbh, $selectHash);
if (defined $hash and length($hash) > 1){
if(argon2id_verify($hash,$pass)){
my $selectuserID = qq{SELECT userID from pigeons where pass='$hash';};
$userID = DbGetLine($dbh, $selectuserID);
if ($userID =~ /^([0-9]+)$/){
$userID = $1;
}
else {
return;
}
return $userID; # as an userID is always > 0, we can use it as return value
} else {
return;
}
} else {
$dbh->disconnect;
return;
}
$dbh->disconnect;
return;
}
sub LoginCookieGen {
my ($userID, $magicCookie, $cookiesDir) = @_;
if (not defined $magicCookie){
my $StrRandObj = String::Random->new;
my $val = $StrRandObj->randregex('\w{64}');
if (not -d "$cookiesDir/$userID"){
mkpath("$cookiesDir/$userID");
}
my $cookieFile = "$cookiesDir/$userID/$val.txt";
my $magicMagicCookie = CGI::Cookie->new(
-name => 'id',
-value => $val,
-expires => '+1y',
'-max-age' => '+1y',
-domain => ".$ENV{'SERVER_NAME'}",
-path => '/',
-secure => 1,
-httponly => 1,
-samesite => 'Strict',
) or die "Can't create cookie $!";
my $newUserIDCookie = CGI::Cookie->new(
-name => 'uid',
-value => $userID,
-expires => '+1y',
'-max-age' => '+1y',
-domain => ".$ENV{'SERVER_NAME'}",
-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$magicMagicCookie\n$newUserIDCookie";
close $out;
print "Set-Cookie: $magicMagicCookie\n";
print "Set-Cookie: $newUserIDCookie\n";
}
}
sub UntaintCGIFilename {
my $filename = shift;
if ($filename =~ /^([-\@\w.\/]+)$/) {
$filename = $1;
}
else {
die "$!";
}
chomp $filename;
return $filename;
}
sub GetRFC822Date {
# https://stackoverflow.com/a/40149475, Daniel VÃritÃ
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 = 0;
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 $dbPath = q{dbPath_goes_here};
my $cookiesDir = q{cookiesDir_goes_here};
my $linkTemplatePath = q{linkTemplatePath_goes_here};
my $invitesTemplatePath = q{invite_template_goes_here};
my $cgiQueryGet = CGI->new;
my $username = $cgiQueryGet->param('username');
my $pass = $cgiQueryGet->param('password');
my $disconnect = $cgiQueryGet->param('disconnect');
my $adminpanselect = $cgiQueryGet->param('adminpan');
my ( $checkedOrNot, $hiddenLoginField, $magicCookie,
$UIDCookie, $ID, $refreshForm,
$userID) = undef;
my $linkGenNotif = my $sentMailNotif = my $mailIsOkNotif = my $deletionNotif = my $loginNotif = my $adminPanelField = my $adminbtn = '';
my @createdLinks = ();
my %currentCookies = CGI::Cookie->fetch;
$UIDCookie = $currentCookies{'uid'};
$magicCookie = $currentCookies{'id'};
my $dbh = DBI->connect("DBI:SQLite:dbname=$dbPath", undef, undef, { RaiseError => 1})
or die $DBI::errstr;
if ($adminpanselect){
$adminPanelField = q{};
}
if (not defined $magicCookie){ # cookie is not set
$hiddenLoginField = qq{};
$refreshForm = qq{};
}
else{
$hiddenLoginField = qq{};
$refreshForm = qq{};
$ID = $magicCookie->value;
if ($ID =~ /^([\w]+)$/){
$ID = $1;
}
$userID = $UIDCookie->value;
if ($userID =~ /^([0-9]+)$/){
$userID = $1;
}
}
if ($disconnect and defined $magicCookie){ # if we disconnect and cookie is active
my $deleteIDCookie = CGI::Cookie->new(
-name => 'id',
-value => $ID,
-expires => '-1d',
'-max-age' => '-1d',
-domain => ".$hostname",
-path => '/',
-secure => 1,
-httponly => 1,
-samesite => 'Strict',
);
my $deleteUIDCookie = CGI::Cookie->new(
-name => 'uid',
-value => $userID,
-expires => '-1d',
'-max-age' => '-1d',
-domain => ".$hostname",
-path => '/',
-secure => 1,
-httponly => 1,
-samesite => 'Strict',
);
my $f = "$cookiesDir/$userID/$ID.txt";
if (-e "$f"){
unlink "$f" or die "cant delete cookie at $f :$!\n"; # delet it
}
print "Set-Cookie: $deleteUIDCookie\n";
print "Set-Cookie: $deleteIDCookie\n";
}
my $loginOK = LoginOk($dbh, $username, $pass, $userID, $magicCookie, $UIDCookie, $cookiesDir);
print "Cache-Control: no-store, must-revalidate\n";
if($loginOK){
$userID = $loginOK;
my $userMailAddr = DbGetLine($dbh, qq{SELECT mail from pigeons where userID='$userID';});
my $nick = DbGetLine($dbh, qq{SELECT name from pigeons where userID='$userID';});
my $isAdmin = DbGetLine($dbh, qq{SELECT isadmin from pigeons where userID='$userID';});
LoginCookieGen($userID, $magicCookie, $cookiesDir);
if ($isAdmin){
$adminbtn = qq{};
if (not -d "i/$userID"){
mkpath("./i/$userID");
}
}
if (not -d "./l/$userID"){
mkpath("./l/$userID");
}
if (defined $cgiQueryGet->param('supprlien')){
my $pendingDeletion = $cgiQueryGet->param('supprlien');
#make sure smart and malicious users don't go deleting other things
if ($pendingDeletion =~ /^l\/$userID\/([\w]+)\.cgi$/ or $pendingDeletion =~ /^i\/$userID\/([\w]+)\.cgi$/) {
if (unlink UntaintCGIFilename($pendingDeletion)){
$deletionNotif=qq{$textStrings{link_del_ok}};
}
else {
$deletionNotif=qq{$textStrings{link_del_failed} $pendingDeletion: $!};
}
}
}
if (defined $cgiQueryGet->param('supprtout')){
rmtree("./l/$userID", {keep_root=>1, safe=>1});
$deletionNotif=qq{$textStrings{link_del_ok}};
}
if (defined $cgiQueryGet->param('delallinvites')){
rmtree("./i/$userID", {keep_root=>1, safe=>1});
$deletionNotif=qq{$textStrings{link_del_ok}};
}
if (defined $cgiQueryGet->param('geninv')){
my $inviteAsker = scalar $cgiQueryGet->param('opt-mail');
$mailIsOkNotif = qq{$textStrings{addr} $inviteAsker $textStrings{addr_nok}};
my $StrRandObj = String::Random->new;
my $randomFilename = $StrRandObj->randregex('\w{64}');
my $generatedFormFilename = "$randomFilename.cgi";
my $hrefLink = "https://$hostname/cgi-bin/i/$userID/$generatedFormFilename";
my $invitesPath = "./i/$userID/$generatedFormFilename";
open my $in, '<', $invitesTemplatePath or die "Can't read link template file: $!";
open my $out, '>', $invitesPath or die "Can't write to link file: $!";
while( <$in> ) {
if ( Email::Valid->address($inviteAsker) ){
$mailIsOkNotif = qq{$textStrings{addr} $inviteAsker $textStrings{addr_ok}};
s/mail = undef;/mail = q{$inviteAsker};/g;
s/{mailfield_goes_here}/{}/g;
}
s/{mailfield_goes_here}/{}/g;
if (defined $cgiQueryGet->param('mailnotif') ){
s/EMAIL_NOTIF = .*/EMAIL_NOTIF = q{1};/g
}
if (defined $cgiQueryGet->param('adminprom') ){
s/is_admin_goes_here/1/g
}
else{
s/is_admin_goes_here/0/g
}
s/{userMailAddr_goes_here}/{$userMailAddr}/g;
print $out $_;
}
close $in or die;
chmod(0755,$invitesPath) or die;
close $out or die;
$linkGenNotif = qq{$textStrings{link_generated_ok}: $hrefLink};
if (defined $cgiQueryGet->param('invitemail') and Email::Valid->address($inviteAsker)){
SendGpigeonMail($inviteAsker,"[GPIGEON](Do not reply) You have been invited to $hostname","Greetings,\n\n\tYou have been invited to create an GPIGEON account 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\@les-miquelots.net about it.\n\nKind regards,\nGpigeon mailing system at $hostname.") or $sentMailNotif = "$!";
}
}
if (defined $cgiQueryGet->param('mail')){
my $linkAsker = scalar $cgiQueryGet->param('mail');
if ( Email::Valid->address($linkAsker) ){
$mailIsOkNotif = qq{$textStrings{addr} $linkAsker $textStrings{addr_ok}};
my $StrRandObj = String::Random->new;
my $randomFilename = $StrRandObj->randregex('\w{64}');
my $generatedFormFilename = "$randomFilename.cgi";
my $hrefLink = "https://$hostname/cgi-bin/l/$userID/$generatedFormFilename";
my $linkPath = "./l/$userID/$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;
s/{userMailAddr_goes_here}/{$userMailAddr}/g;
print $out $_;
}
close $in or die;
chmod(0755,$linkPath) or die;
close $out or die;
$linkGenNotif = qq{$textStrings{link_generated_ok}: $hrefLink};
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\@les-miquelots.net about it.\n\nKind regards,\nGpigeon mailing system at $hostname.") or $sentMailNotif="$!" ;
}
}
else{
$mailIsOkNotif = qq{$textStrings{addr} $linkAsker $textStrings{addr_nok}};
}
}
my @linksTable = GetFileTable("l/$userID", $hiddenLoginField, $adminPanelField);
print 'Content-type: text/html',"\n\n";
if ($adminpanselect and $isAdmin){
my @invitesTable = GetFileTable("i/$userID", $hiddenLoginField, $adminPanelField);
print qq{
$textStrings{web_title}
GPIGEON - Admin panel
Welcome to the admin panel. Here, you can view and generate account invites and also search and delete users.