Merge branch 'perlmod'

1 files changed, 287 insertions, 0 deletions

diff --git a/lib/Mail/Run/Crypt.pm b/lib/Mail/Run/Crypt.pm
new file mode 100644
index 0000000..c37a622
--- /dev/null
+++ b/lib/Mail/Run/Crypt.pm
@@ -0,0 +1,287 @@
+package Mail::Run::Crypt;
+
+# Force me to write this properly
+use strict;
+use warnings;
+use utf8;
+
+# Target Debian-Squeeze-era Perl
+# We may be able to go older; not sure yet
+use 5.010;
+
+# Import required modules
+use Carp;
+use Const::Fast;
+use English '-no_match_vars';
+use IPC::Run3;
+use Mail::GnuPG;
+use MIME::Entity;
+
+# Specify package verson
+our $VERSION = '0.01';
+
+# Default exit value
+const our $DEFAULT_EXIT => 127;
+
+# Oldschool constructor
+sub new {
+    my ( $class, %opts ) = @_;
+
+    # Blindly slurp in all the options given
+    my $self = {%opts};
+
+    # We must have a key ID and a recipient, but not necessarily a passphrase
+    for my $req (qw(keyid mailto)) {
+        $self->{$req} // croak "$req required";
+    }
+
+    # Default the instance name to the package name if it wasn't given;
+    # croncrypt(1p) will pass it in
+    $self->{name} //= $class;
+
+    # Return objectified self
+    return bless $self, $class;
+}
+
+# Run a given command
+sub run {
+    my ( $self, @command ) = @_;
+
+    # Run the command and wait for it to finish; keep its exit value for later
+    my ( @out, @err );
+    eval { run3 \@command, undef, \@out, \@err }
+      or carp "Command failed: $EVAL_ERROR";
+    $self->{exit} = $CHILD_ERROR >> 8;
+
+    # If there was output, mail it
+    if (@out) {
+        my $command = join q{ }, @command;
+        my $subject = "$self->{name} output: $command";
+        $self->_mail( $subject, \@out );
+    }
+
+    # If there were errors, mail them
+    if (@err) {
+        my $command = join q{ }, @command;
+        my $subject = "$self->{name} errors: $command";
+        $self->_mail( $subject, \@err );
+    }
+
+    # Return status reflecting the command exit value
+    return $self->{exit} == 0;
+}
+
+# Return the value of the most recently run command, or 1 otherwise
+sub bail { return shift->{exit} // $DEFAULT_EXIT }
+
+# Send the message to the address in $ENV{MAILTO}
+sub _mail {
+    my ( $self, $subject, $content ) = @_;
+
+    # Build MIME object with plaintext message
+    my $mime = MIME::Entity->build(
+        To      => $self->{mailto},
+        Subject => $subject,
+        Data    => $content,
+    );
+
+    # Encrypt the MIME object
+    my $mgpg = Mail::GnuPG->new(
+        key        => $self->{keyid},
+        passphrase => $self->{passphrase},
+    );
+    $mgpg->mime_signencrypt( $mime, $self->{mailto} );
+
+    # Send it
+    return $mime->send();
+}
+
+1;
+
+__END__
+
+=pod
+
+=for stopwords
+mailserver decrypt croncrypt GPG OpenPGP tradename licensable MERCHANTABILITY
+
+=encoding utf8
+
+=head1 NAME
+
+Mail::Run::Crypt - Encrypt and mail output from command runs
+
+=head1 VERSION
+
+Version 0.01
+
+=head1 DESCRIPTION
+
+This module runs commands with C<IPC::Run3::run3()>, and collects any standard
+output and standard error it emits. If there is any standard output or standard
+error content, it is mailed (each stream separately) to a specified recipient
+address.
+
+The idea is to allow you to view the output of automated commands while having
+the content encrypted as it passes through to your mailserver, and have some
+assurance that the content was actually generated by the server concerned.
+C<cron(8)> scripts are the ideal use case, but this would also with C<at(1)> or
+anything else that might non-interactively run jobs for which output is
+significant.
+
+You probably want to call this with the C<croncrypt(1)> program installed by
+this distribution, which provides a means to set the properties for the module
+via environment variables or command-line options.
+
+=head1 SYNOPSIS
+
+    my $mrc = Mail::Run::Crypt->new(
+        keyid      => 0x1234DEAD,
+        passphrase => 'extremely_insecure',
+        mailto     => 'you@example.net',
+    );
+    $mrc->run(qw(rsync -a /mnt/a/ remote:mnt/b));
+    
+=head1 SUBROUTINES/METHODS
+
+=head2 B<new(%opts)>
+
+Constructor accepts the following named parameters:
+
+=over 4
+
+=item C<keyid>
+
+The GnuPG key ID that should be used to encrypt the messages.
+
+=item C<passphrase>
+
+The passphrase used to decrypt the key.
+
+=item C<mailto>
+
+The recipient email address for the content.
+
+=item C<name>
+
+(Optional) The name of the object. When called from the C<croncrypt(1)>
+program, this will be the string "croncrypt".
+
+=head2 B<run(@command)>
+
+Run the specified arguments as a command with C<IPC::Run3::run3()>, and email
+any output or error content to the email recipient.
+
+=head2 B<bail()>
+
+Return the exit status of the most recently run command, or 127 if no command
+has been successfully run.
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item %s required
+
+One of the required properties was not passed to the constructor.
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+You will need to have a functioning GnuPG public key setup for this to work,
+including the secret key. You should definitely not use your personal key;
+generate one specifically for mail signing and encryption instead.
+
+=head1 DEPENDENCIES
+
+=over 4
+
+=item *
+
+Perl v5.10.0 or newer
+
+=item *
+
+C<Carp>
+
+=item *
+
+C<Const::Fast>
+
+=item *
+
+C<English>
+
+=item *
+
+C<IPC::Run3>
+
+=item *
+
+C<Mail::GnuPG>
+
+=item *
+
+C<MIME::Entity>
+
+=back
+
+=head1 INCOMPATIBILITIES
+
+This module uses C<Mail::GnuPG> and other GPG-specific code, so it won't work
+with any other OpenPGP implementations.
+
+=head1 BUGS AND LIMITATIONS
+
+Providing the C<passphrase> directly from an environment variable is not great.
+The documentation needs to make that clear and offer a less bad alternative,
+probably specifying the path to a secure file that it refuses to use unless it
+has sufficiently restrictive permissions.
+
+This is very hard to test and the author has not yet figured out how to do
+that.
+
+=head1 AUTHOR
+
+Tom Ryder C<< <tom@sanctum.geek.nz> >>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (C) 2017 Tom Ryder
+
+This program is free software; you can redistribute it and/or modify it under
+the terms of the Artistic License (2.0). You may obtain a copy of the full
+license at:
+
+L<http://www.perlfoundation.org/artistic_license_2_0>
+
+Any use, modification, and distribution of the Standard or Modified Versions is
+governed by this Artistic License. By using, modifying or distributing the
+Package, you accept this license. Do not use, modify, or distribute the
+Package, if you do not accept this license.
+
+If your Modified Version has been derived from a Modified Version made by
+someone other than you, you are nevertheless required to ensure that your
+Modified Version complies with the requirements of this license.
+
+This license does not grant you the right to use any trademark, service mark,
+tradename, or logo of the Copyright Holder.
+
+This license includes the non-exclusive, worldwide, free-of-charge patent
+license to make, have made, use, offer to sell, sell, import and otherwise
+transfer the Package with respect to any patent claims licensable by the
+Copyright Holder that are necessarily infringed by the Package. If you
+institute patent litigation (including a cross-claim or counterclaim) against
+any party alleging that the Package constitutes direct or contributory patent
+infringement, then this Artistic License to you shall terminate on the date
+that such litigation is filed.
+
+Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
+CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
+WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
+NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW.
+UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY
+OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.
+
+=cut