diff options
Diffstat (limited to 'lib/Mail/Run/Crypt.pm')
-rw-r--r-- | lib/Mail/Run/Crypt.pm | 287 |
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 |