Protocol-ACME-1.01/000755 054744 001130 00000000000 13000266153 013355 5ustar00sludin000000 000000 Protocol-ACME-1.01/Changes000644 054744 001130 00000004600 13000262516 014647 0ustar00sludin000000 000000 Revision history for Protocol-ACME 1.01 Fri Oct 14 - Congratulations. Promoting to Version 1.00 1.00 Mysteriously Skipped 0.16 Wed Aug 10 - Catches json decode errors and bubbles them up - Added the implicit SSL dependencies of HTTP::Tiny 0.15 Mon Jul 6 - Changed tests so setting NO_NETWORK environment variable will skip the network tests direct to Let's Encrypt - Adjusted MANIFEST so that client.pl and revoke.pl will not be installed (moved to examples directory) 0.14 Mon Jul 6 - Typos in ACME.pm POD 0.13 Mon Jul 6 - No changes of consequence 0.12 Fri Apr 29 - Added cleanup routines to take care of removing the challenge files when complete. - Fixed a bug where the 'mailto' scheme was not added to the registraion calls. - Fixed bug with the order of execution of setgid and setuid - Refactored logging clde - Lowered dependency version - Typos 0.11 Fri Jan 29 - Version bump to deal with a missing version in a number of files 0.10 Thu Jan 28 - Added a 'chain' call - Added the ability in set the mailto argument 0.09 Tue Jan 19 - Made the log level configurable - Added more tests 0.08_01 Mon Jan 18 - Added flexibility calls that take a PEM/DER string/filename - Fixed various minor bugs - Changes to the SimpleSSH challenge to create target directory as needed - Updated docs - deprecated load_key_from_disk - changed the meaning of the account_key parameter lassed to the constructor - removed the account_key_path paramater from the constructor 0.08 Wed Jan 12 - Moved from LWP to HTTP::Tiny 0.07 Mon Jan 10 - Moved pem2der, der2pem to external module 0.06 Sun Jan 9 - Fixed REPOSITIRY section of POD 0.05 Sat Jan 8 - More flexibility between using PEM and DER - Keys can be passed in via buffer 0.04 Mon Jan 4 16:45:02 PST 2016 - Added ability to chose between using a local openssl binary for crypto and Crypt::OpenSSL::RSA - Changed from the deprecated Digest::SHA2 to Digest::SHA 0.03 Added Revoke support 0.02 Changes lost in the mists of time 0.01 Tue Dec 8 17:01:36 PST 2015 Inital version Protocol-ACME-1.01/examples/000755 054744 001130 00000000000 13000266152 015172 5ustar00sludin000000 000000 Protocol-ACME-1.01/lib/000755 054744 001130 00000000000 13000266152 014122 5ustar00sludin000000 000000 Protocol-ACME-1.01/Makefile.PL000644 054744 001130 00000003605 12752731053 015344 0ustar00sludin000000 000000 use 5.006; use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Protocol::ACME', AUTHOR => q{Stephen Ludin }, VERSION_FROM => 'lib/Protocol/ACME.pm', ABSTRACT_FROM => 'lib/Protocol/ACME.pm', LICENSE => 'artistic_2', PL_FILES => {}, MIN_PERL_VERSION => 5.007003, CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => 0, }, TEST_REQUIRES => { 'Test::More' => 0, 'Test::Exception' => 0, }, META_MERGE => { 'meta-spec' => { version => 2 }, resources => { repository => { type => 'git', url => 'https://github.com/sludin/Protocol-ACME.git', web => 'https://github.com/sludin/Protocol-ACME', }, }, }, PREREQ_PM => { # here the prerequisites are aligned with Debian # stable, if they exists, otherwise to stretch (and # they need backporting: libcrypt-rsa-parse-perl and # libcrypt-format-perl 'Log::Any' => '0.15', 'Log::Any::Adapter' => '0.11', 'Crypt::Format' => '0.04', 'Crypt::OpenSSL::RSA' => '0.28', 'Crypt::RSA::Parse' => '0.02', 'Crypt::OpenSSL::Bignum' => '0.04', 'JSON' => '2.61', 'Digest::SHA' => '5.88', 'HTTP::Tiny' => '0.050', 'Test::Exception' => '0.35', 'IO::Socket::SSL' => '1.56', 'Net::SSLeay' => '1.49', }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Protocol-ACME-*' }, x_contributors => [ 'Felipe Gasper ', 'Tobias Oetiker ' ], ); sub MY::c_o { return <<'MAKE_FRAG'; readme: podselect lib/Protocol/ACME.pm > README.pod MAKE_FRAG } Protocol-ACME-1.01/MANIFEST000644 054744 001130 00000001521 13000266153 014505 0ustar00sludin000000 000000 Changes lib/Protocol/ACME/Challenge/LocalFile.pm lib/Protocol/ACME/Challenge/Manual.pm lib/Protocol/ACME/Challenge/SimpleSSH.pm lib/Protocol/ACME/Challenge.pm lib/Protocol/ACME/Exception.pm lib/Protocol/ACME/Key.pm lib/Protocol/ACME/Logger.pm lib/Protocol/ACME/OpenSSL.pm lib/Protocol/ACME/Utils.pm lib/Protocol/ACME.pm Makefile.PL MANIFEST README.pod examples/maketestcerts.sh examples/client.pl examples/revoke.pl t/00-load.t t/01-dependency_check.t t/02-load_key.t t/03-load_key_openssl.t t/04-load_key_crypt.t t/test_account_key.der t/test_account_key.pem t/test_cert_key.der t/test_cert_key.pem t/test_csr.der t/test_csr.pem t/write_key_files.pl t/lib/Protocol/ACME/Test.pm META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Protocol-ACME-1.01/META.json000644 054744 001130 00000003233 13000266153 014777 0ustar00sludin000000 000000 { "abstract" : "Interface to the Let's Encrypt ACME API", "author" : [ "Stephen Ludin " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Protocol-ACME", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Crypt::Format" : "0.04", "Crypt::OpenSSL::Bignum" : "0.04", "Crypt::OpenSSL::RSA" : "0.28", "Crypt::RSA::Parse" : "0.02", "Digest::SHA" : "5.88", "HTTP::Tiny" : "0.050", "IO::Socket::SSL" : "1.56", "JSON" : "2.61", "Log::Any" : "0.15", "Log::Any::Adapter" : "0.11", "Net::SSLeay" : "1.49", "Test::Exception" : "0.35", "perl" : "5.007003" } }, "test" : { "requires" : { "Test::Exception" : "0", "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "https://github.com/sludin/Protocol-ACME.git", "web" : "https://github.com/sludin/Protocol-ACME" } }, "version" : "1.01" } Protocol-ACME-1.01/META.yml000644 054744 001130 00000001634 13000266153 014632 0ustar00sludin000000 000000 --- abstract: "Interface to the Let's Encrypt ACME API" author: - 'Stephen Ludin ' build_requires: ExtUtils::MakeMaker: '0' Test::Exception: '0' Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Protocol-ACME no_index: directory: - t - inc requires: Crypt::Format: '0.04' Crypt::OpenSSL::Bignum: '0.04' Crypt::OpenSSL::RSA: '0.28' Crypt::RSA::Parse: '0.02' Digest::SHA: '5.88' HTTP::Tiny: '0.050' IO::Socket::SSL: '1.56' JSON: '2.61' Log::Any: '0.15' Log::Any::Adapter: '0.11' Net::SSLeay: '1.49' Test::Exception: '0.35' perl: '5.007003' resources: repository: https://github.com/sludin/Protocol-ACME.git version: '1.01' Protocol-ACME-1.01/README.pod000644 054744 001130 00000027074 13000266024 015025 0ustar00sludin000000 000000 =head1 NAME Protocol::ACME - Interface to the Let's Encrypt ACME API =head1 VERSION Version 1.01 =head1 SYNOPSIS use Protocol::ACME; my @names = qw( www.example.com cloud.example.com ); my $challenges = { 'www.example.com' => Protocol::ACME::Challenge::SimpleSSH->new( { ssh_host => "host1", www_root => "~/www" } ), 'cloud.example.com' => Protocol::ACME::Challenge::SimpleSSH->new( { ssh_host => "home2", www_root => "/opt/local/www/htdocs" } ) }; eval { my $acme = Protocol::ACME->new( host => $host, account_key => $account_key_pem_or_der, ); $acme->directory(); $acme->register(); $acme->accept_tos(); for my $domain ( @names ) { $acme->authz( $domain ); $acme->handle_challenge( $challenges->{$domain} ); $acme->check_challenge(); $acme->cleanup_challenge( $challenges->{$domain} ); } my $cert = $acme->sign( $csr_file ); }; if ( $@ ) { die if !UNIVERSAL::isa($@, 'Protocol::ACME::Exception'); die "Error occurred: Status: $@->{status}, Detail: $@->{detail}, Type: $@->{type}\n"; } else { # do something appropriate with the DER encoded cert print "Success\n"; } =head1 DESCRIPTION The C is a class implementing an interface for the Let's Encrypt ACME API. The class handles the protocol details behind provisioning a Let's Encrypt certificate. =head1 CONSTRUCTOR METHODS The following constructor methods are available: =over 4 =item $acme = Protcol::ACME->new( %options ) This method constructs a new C object and returns it. Key/value pair arguments may be provided to set up the initial state. The may be passed in as a hash or a hashref. The following options correspond to attribute methods described below. Items marked with a * are required. KEY DEFAULT ----------- -------------------- *host undef account_key undef openssl undef ua HTTP::Tiny->new() loglevel error debug 0 mailto undef B: The API end point to connect to. This will generally be acme-staging.api.letsencrypt.org or acme-v01.api.letsencrypt.org B: The account private key in a scalar ref or filename. See C<$self->account_key> for details on this arguemtn. B: The path to openssl. If this option is used a local version of the openssl binary will be used for crypto operations rather than C. B: An HTTP::Tiny object customized as you see fit B: Set the loglevel to one of the C values. B: If set to non-zero this is a shortcut for C debug> B: This should be the email address that you want associated with your account. This is used my Let's Encrypt for expiration notification. =back =head2 METHODS =over =item account_key( $key_filename ) =item account_key( \$buffer ) =item account_key( \%explicit_args ) C will load a the private account key if it was not already loaded when the C object was constructed. There are three ways to call this: If the arg is a B it is assumed to be the filename of the key. C will throw an error if there are problems reading the file. If the arg is a B reference it is assumed to be a buffer that contains the KEY. If the arg is a B reference it contains named arguments. The arguments are: KEY DEFAUL DESC ----------- ----------- ------------------- filename undef The key Filename buffer undef Buffer containing the key format undef Explicitly state the format ( DER | PEM ) If both C and C are set the C argument will be ignored. If the format is not explcitly set C will look at the key and try and determine what the format it. =item load_key_from_disk( $key_path ) B Load a key from disk. Currently the key needs to be unencrypted. Callbacks for handling password protected keys are still to come. =item directory() Loads the directory from the ACME host. This call must be made first before any other calls to the API in order the bootstrap the API resource list. =item register( %args ) Call the new-reg resource and create an account associated with the loaded account key. If that key has already been registered this method will gracefully and silently handle that. Arguments that can be passed in: KEY DEFAULT ----------- -------------------- mailto undef B: See C for a desciption. This will override the value passed to new if any. =item accept_tos() In order to use the Let's Encrypt service, the account needs to accept the Terms of Service. This is provided in a link header in response to the new-reg ( or reg ) resource call. If the TOS have already been accepted as indicated by the reg structure returned by the API this call will be a noop. =item authz( $domain ) C needs to be called for each domain ( called identifiers in ACME speak ) in the certificate. This included the domain in the subject as well as the Subject Alternate Name (SAN) fields. Each call to C will result in a challenge being issued from Let's Encrypt. These challenges need to be handled individually. =item handle_challenge( $challenge_object ) C is called for each challenge issued by C. The challenge object must be a subclass of C which implements a 'handle' method. This objects handle method will be passed three arguments and is expected to fulfill the preconditions for the chosen challenge. The three areguments are: fingerprint: the sha256 hex digest of the account key token: the challenge token url: the url returned by the challenge Fully describing how to handle every challenge type of out of the scope of this documentation ( at least for now ). Two challenge classes have been included for reference: C is initialized with the ssh host name and the www root for the web server for the http-01 challenge. It will ssh to the host and create the file in the correct location for challenge fulfillment. C is initialized with just the www root for the web server for the http-01 challenge. It will simply create the challenge file in the correct place on the local filesystem. C is intended to be run in an interactive manner and will stop and prompt the user with the relevant information so they can fulfill the challenge manually. but below is an example for handling the simpleHTTP ( http-01 ) challenge. =item check_challenge() Called after C. This will poll the challenge status resource and will return when the state changes from 'pending'. =item cleanup_challenge() Called after C to remove the challenge files. =item $cert = sign( $csr_filename ) =item $cert = sign( \$buffer ) =item $cert = sign( \%explicit_args ) Call C after the challenge for each domain ( itentifier ) has been fulfilled. There are three ways to call this: If the arg is a B it is assumed to be the filename of the CSR. C will throw an error if there are problems reading the file. If the arg is a B reference it is assumed to be a buffer that contains the CSR. If the arg is a B reference it contains named arguments. The arguments are: KEY DEFAUL DESC ----------- ----------- ------------------- filename undef The CSR Filename buffer undef Buffer containing the CSR format undef Explicitly state the format ( DER | PEM ) If both C and C are set the C argument will be ignored. If the format is not explcitly set Protocol::ACME will look at the CSR and try and determine what the format it. On success C will return the DER encoded signed certificate. =item $cert_chain = chain() After C has been called and a cert successfully created, C will fetch and return the DER encoded certificate issuer. =item revoke( $certfile ) Call C to revoke an already issued certificate. C<$certfile> must point the a DER encoded form of the certificate. =item recovery_key() LE does not yet support recovery keys. This method will die when called. =back =head1 AUTHOR Stephen Ludin, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 REPOSITORY https://github.com/sludin/Protocol-ACME =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Protocol::ACME You can also look for information at: =over 4 =item * RT: CPAN's request tracker (report bugs here) L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 CONTRIBUTORS Felipe Gasper, C<< >> =head1 ACKNOWLEDGEMENTS =head1 LICENSE AND COPYRIGHT Copyright 2015 Stephen Ludin. This program is free software; you can redistribute it and/or modify it under the terms of the the Artistic License (2.0). You may obtain a copy of the full license at: L Any use, modification, and distribution of the Standard or Modified Version 1.01 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. Protocol-ACME-1.01/t/000755 054744 001130 00000000000 13000266152 013617 5ustar00sludin000000 000000 Protocol-ACME-1.01/t/00-load.t000644 054744 001130 00000001417 12644066641 015161 0ustar00sludin000000 000000 #!perl -T use 5.006; use strict; use warnings; use Test::More; plan tests => 8; BEGIN { use_ok( 'Protocol::ACME' ) || print "Bail out!\n"; use_ok( 'Protocol::ACME::Challenge' ) || print "Bail out!\n"; use_ok( 'Protocol::ACME::Challenge::SimpleSSH' ) || print "Bail out!\n"; use_ok( 'Protocol::ACME::Challenge::LocalFile' ) || print "Bail out!\n"; use_ok( 'Protocol::ACME::Challenge::Manual' ) || print "Bail out!\n"; use_ok( 'Protocol::ACME::Key' ) || print "Bail out!\n"; use_ok( 'Protocol::ACME::OpenSSL' ) || print "Bail out!\n"; use_ok( 'Protocol::ACME::Utils' ) || print "Bail out!\n"; } #diag( "Testing Protocol::ACME $Protocol::ACME::VERSION, Perl $], $^X" ); Protocol-ACME-1.01/t/01-dependency_check.t000644 054744 001130 00000000710 12650211736 017503 0ustar00sludin000000 000000 #!perl use 5.006; use strict; use warnings; use Test::More; use MIME::Base64 qw( encode_base64url ); use lib 't/lib'; use Protocol::ACME::Test; plan tests => 1; # If there is not OpenSSL binary and no Crypt::OpenSSL::RSA fail # At least of these is needed to run the module if ( ! $Protocol::ACME::Test::openssl && ! $Protocol::ACME::Test::rsa ) { diag( "The openssl binary or Crypt::OpenSSL::RSA must be present" ); ok(0); } else { ok(1); } Protocol-ACME-1.01/t/02-load_key.t000644 054744 001130 00000013155 12737217601 016032 0ustar00sludin000000 000000 #!perl use 5.006; use strict; use warnings; use Test::More; use Test::Exception; use Crypt::RSA::Parse; use Data::Dumper; use Protocol::ACME; use MIME::Base64 qw( encode_base64url ); use lib 't/lib'; use Protocol::ACME::Test; my $tests = 47; plan tests => $tests; my $test_objs = $Protocol::ACME::Test::test_objs; sub _bigint_to_binary { my ( $bigint ) = @_; # TODO: Inelegant hack to deal with different Bignum implementations my $hex; if ( UNIVERSAL::isa( $bigint, "Math::BigInt" ) ) { $hex = substr( $bigint->as_hex(), 2 ); #Prefix a 0 as needed to get an even number of digits. if (length($hex) % 2) { substr( $hex, 0, 0, 0 ); } return pack 'H*', $hex; } else { $bigint->to_bin(); } } sub check_key { my $key = shift; my $private_rsa = Crypt::RSA::Parse::private($test_objs->{account_key}->{pem}); if ( $key->{n} ne encode_base64url(_bigint_to_binary($private_rsa->modulus())) ) { return 0; } return 1; } eval { our $acme; SKIP: { if ( ! $Protocol::ACME::Test::rsa || ! $Protocol::ACME::Test::bignum ) { skip "Crypt::OpenSSL::Bignum or Crypt::OpenSSL::RSA not found", 23; } lives_ok { $acme = Protocol::ACME->new( host => $Protocol::ACME::Test::host, debug => 1 ) } 'Create ACME Object'; lives_ok { $acme->account_key( \$test_objs->{account_key}->{pem} ) } 'Load PEM Buffer'; ok ( check_key( $acme->{key} ) ); lives_ok { $acme->account_key( \$test_objs->{account_key}->{der} ) } 'Load DER Buffer'; ok ( check_key( $acme->{key} ) ); lives_ok { $acme->account_key( "t/$test_objs->{account_key}->{filename}.pem" ) } 'Load PEM File'; ok ( check_key( $acme->{key} ) ); lives_ok { $acme->account_key( "t/$test_objs->{account_key}->{filename}.der" ) } 'Load DER File'; ok ( check_key( $acme->{key} ) ); lives_ok { $acme->account_key( { buffer => $test_objs->{account_key}->{pem} } ) } 'Load PEM Buffer 2'; ok ( check_key( $acme->{key} ) ); lives_ok { $acme->account_key( { buffer => $test_objs->{account_key}->{der} } ) } 'Load DER Buffer 2'; ok ( check_key( $acme->{key} ) ); lives_ok { $acme->account_key( { filename => "t/$test_objs->{account_key}->{filename}.pem" } ) } 'Load PEM File 2'; ok ( check_key( $acme->{key} ) ); lives_ok { $acme->account_key( { filename => "t/$test_objs->{account_key}->{filename}.der" } ) } 'Load DER File 2'; ok ( check_key( $acme->{key} ) ); dies_ok { $acme->account_key( { buffer => $test_objs->{account_key}->{pem}, format => "DER" } ) } 'Load PEM Buffer 3'; lives_ok { $acme->account_key( { buffer => $test_objs->{account_key}->{pem}, format => "PEM" } ) } 'Load PEM Buffer 4'; ok ( check_key( $acme->{key} ) ); dies_ok { $acme->account_key( { buffer => $test_objs->{account_key}->{der}, format => "PEM" } ) } 'Load DER Buffer 3'; lives_ok { $acme->account_key( { buffer => $test_objs->{account_key}->{der}, format => "DER" } ) } 'Load DER Buffer 4'; ok ( check_key( $acme->{key} ) ); $acme = undef; } SKIP: { skip "openssl binary not found", 24 unless $Protocol::ACME::Test::openssl; lives_ok { $acme = Protocol::ACME->new( host => $Protocol::ACME::Test::host, openssl => $Protocol::ACME::Test::openssl, debug => 1 ) } 'Create ACME Object - OpenSSL'; lives_ok { $acme->account_key( \$test_objs->{account_key}->{pem} ) } 'Load PEM Buffer - OpenSSL'; ok ( check_key( $acme->{key} ) ); lives_ok { $acme->account_key( \$test_objs->{account_key}->{der} ) } 'Load DER Buffer - OpenSSL'; ok ( check_key( $acme->{key} ) ); lives_ok { $acme->account_key( "t/$test_objs->{account_key}->{filename}.pem" ) } 'Load PEM File - OpenSSL'; ok ( check_key( $acme->{key} ) ); lives_ok { $acme->account_key( "t/$test_objs->{account_key}->{filename}.der" ) } 'Load DER File - OpenSSL'; ok ( check_key( $acme->{key} ) ); lives_ok { $acme->account_key( { buffer => $test_objs->{account_key}->{pem} } ) } 'Load PEM Buffer 2 - OpenSSL'; ok ( check_key( $acme->{key} ) ); lives_ok { $acme->account_key( { buffer => $test_objs->{account_key}->{der} } ) } 'Load DER Buffer 2 - OpenSSL'; ok ( check_key( $acme->{key} ) ); lives_ok { $acme->account_key( { filename => "t/$test_objs->{account_key}->{filename}.pem" } ) } 'Load PEM File 2 - OpenSSL'; ok ( check_key( $acme->{key} ) ); lives_ok { $acme->account_key( { filename => "t/$test_objs->{account_key}->{filename}.der" } ) } 'Load DER File 2 - OpenSSL'; ok ( check_key( $acme->{key} ) ); dies_ok { $acme->account_key( { buffer => $test_objs->{account_key}->{pem}, format => "DER" } ) } 'Load PEM Buffer 3 - OpenSSL'; lives_ok { $acme->account_key( { buffer => $test_objs->{account_key}->{pem}, format => "PEM" } ) } 'Load PEM Buffer 4 - OpenSSL'; ok ( check_key( $acme->{key} ) ); # NOTE: becasue of the way Crypt::RSA::Parse was written, the 'format' is effectively ignored hence this works regardless. lives_ok { $acme->account_key( { buffer => $test_objs->{account_key}->{der}, format => "PEM" } ) } 'Load DER Buffer 3 - OpenSSL'; ok ( check_key( $acme->{key} ) ); lives_ok { $acme->account_key( { buffer => $test_objs->{account_key}->{der}, format => "DER" } ) } 'Load DER Buffer 4 - OpenSSL'; ok ( check_key( $acme->{key} ) ); } }; if ( $@ ) { diag ( $@ ); } Protocol-ACME-1.01/t/03-load_key_openssl.t000644 054744 001130 00000002110 12737230545 017565 0ustar00sludin000000 000000 #!perl use 5.006; use strict; use warnings; use Test::More; use File::Temp qw( tempfile ); use FindBin; use File::Spec; use Protocol::ACME; use Test::Exception; use lib 't/lib'; use Protocol::ACME::Test; my $tests = 5; # Testing the openssl version of the library if ( ! $Protocol::ACME::Test::openssl ) { plan skip_all => "Cannot find openssl binary for testing"; } elsif ( defined $ENV{NO_NETWORK} ) { plan skip_all => "Network tests disabled (NO_NETWORK set)"; } else { plan tests => $tests; } our $pkey; eval { our $acme; lives_ok { $acme = Protocol::ACME->new( host => $Protocol::ACME::Test::host, account_key => \$Protocol::ACME::Test::account_key_pem, openssl => $Protocol::ACME::Test::openssl ); } 'Create ACME Object'; ok($acme); lives_ok { $acme->directory(); } 'Get the ACME directory'; lives_ok { $acme->register(); } 'Register'; lives_ok { $acme->accept_tos(); } 'Accept TOS'; }; if ( $@ ) { diag( $@ ); } Protocol-ACME-1.01/t/04-load_key_crypt.t000644 054744 001130 00000002113 12737230552 017245 0ustar00sludin000000 000000 #!perl use 5.006; use strict; use warnings; use Test::More; use File::Temp qw( tempfile ); use FindBin; use File::Spec; use Protocol::ACME; use Test::Exception; use lib 't/lib'; use Protocol::ACME::Test; my $tests = 5; # Testing the Crypt::OpenSSL::RSA version of the library if ( ! $Protocol::ACME::Test::rsa || ! $Protocol::ACME::Test::bignum ) { plan skip_all => "Crypt::OpenSSL::RSA/Bignum not present"; } elsif ( $ENV{NO_NETWORK} ) { plan skip_all => "Network tests disabled (NO_NETWORK set)"; } else { plan tests => $tests; } our $pkey; eval { our $acme; lives_ok { $acme = Protocol::ACME->new( host => $Protocol::ACME::Test::host, account_key => \$Protocol::ACME::Test::account_key_pem, loglevel => 'debug', ); } 'Create ACME Object'; ok($acme); lives_ok { $acme->directory(); } 'Get the ACME directory'; lives_ok { $acme->register(); } 'Register'; lives_ok { $acme->accept_tos(); } 'Accept TOS'; }; if ( $@ ) { diag( $@ ); } Protocol-ACME-1.01/t/lib/000755 054744 001130 00000000000 13000266152 014365 5ustar00sludin000000 000000 Protocol-ACME-1.01/t/test_account_key.der000644 054744 001130 00000002301 12650211736 017662 0ustar00sludin000000 000000 00  *H 08Ąt[B5FW rլq-ya/w>k s眈ĥڣa|5#0f Uڶ ?k!чd*e]':}搕-!(fN+5_}NiLN,G~~U†6)2߶ܚFC$ y"D`^4\W)/KWn[`v!-#^PH7B//˘24;*Ra̚˺uø[W]̢8!j8hVfdb3cBHZtRu-k,bMc_7:6_@XH.,Yb{끎 ;狖K{<8*2٠RǛI kxy3<~oԔ#x B"Qh-S-ԓ4BDQP#-w=,?L0-iULyO<׏&ĈO2z.;in2$wF,:pe3)d),~U5nNGif:EOY5;Ko(.c/_U3~.-zufdZRnrh xz?ZƌvXGԧY L|#Iq/ў\U!k5hfs{+.w5E*+7l⹻$dLKF%wæɑŐwZ?Hdz~!ٕg=;ZL,3m\reYSWuޛ{ dNиSQ{^لMVKE/?'^Js(% /!0GcÈxDCLZAVvDT5PUZ&fXti&e5ĩzrQEu)}NyMcboQۤ@V(%N>LEg0_ܖ(A:bKiE 0]Stژ}hI? zonᡅK $BFZu=䞭|sảqzZʅ'kxC|^'I+p%\Protocol-ACME-1.01/t/test_account_key.pem000644 054744 001130 00000003250 12650211736 017675 0ustar00sludin000000 000000 -----BEGIN PRIVATE KEY----- MIIEvQIBADANBgkqhkiG9w0BAQEFAASCBKcwggSjAgEAAoIBAQDHGxwbOMSEvw90 GluzQjVGAKn7ytfcGVccGrsKEHLJ1axxLcJ5svLfBa2JYcAEL/Kp+rJ3PvWJhbNr uZEO77XbCvlz55yIxKXao39hfDUjwZ0wZgmPoVXatgmdP49rIdGH9O1kKvyTg/Vl ptVdmCf2On2l5pCVEJIt+KEhiR4oZsROEd0rNV99TrlpqNbtTJHwAO5OmcIs0uP/ F9hHfsx+139VhezChjaAKTL/37bcmu30hQJGQ5qy9hskvfcb4b4MeSIQ8uYIRGAH XjSOmefEFgAAXMn7p8RXKS+35clLV24YW2ADkIV2lfMWIYzHHS2MI8kclOERs16V G1BIpjfbAgMBAAECggEAQi8vy5i2Mo40O9rbKp5SiR+FYa6OzJoby7rS+8h178O4 W7LjV4L1ms8PXYCBzKKHnps4Ic1q3zjzaFa58mYaZGKkgzO1Y/1CSIhaunQIUgd1 EfaJLRZrLJWgYoYTTYBjXzc6hjaH2R1fQFgRytfeSMoupCwdWX+1p9Ri83vZ64GO ywq/GuQ7iueLlt4HrUvi6el7pbY80DjTKjKT2aD+Uo3Hm61JoA0DGGt4gJf9eZ+A MzzW6hsftNbqqH5vBNSUroT6wLUA/yPfeApCIswbUeCIsOLxq6zy2WgtGZkS2viS s1PALdSToZ2h6zSf2xrwQrlEgO+DAVGnjFC11OHL2QKBgQD6oSMtt3fnPSw/EEzv FjAtac4aiYnOVUx5Tzyc14/yyialxIimFotPMvp61S6KzjuRq4Zpg5reyW6IMiQE iXdGLDq8v5Ce789w5GXuMw/RKdRk7CmFFdYsflU1H8Ju006JR2lmOgCSwkVPulnR +to1xuE7S2+IA8woyS7xYwEFLwKBgQDLX1Uzfi7XGsnPLRjAunp1ZrxkWrQZUqWN im6LcuJoDbF4hQEdetc/p1rGjKr3dljyR9SnplmahwkRAn/poEx8I/VJz+BxL8jR nlxVkyGqa9E16Ghmyuy4c9B7mgcrLneYEfubE9s1h/yBRSocK+s3oWyh4rm7JMNk 30xLRv8lFQKBgHfnw6bJkcnFkHeTWts/qEjxx7MWfiGC2ZVn/T2kO7ASWq8P+bhM LNX1M7S0bRHnXMRyZVnxppRTllf+dRDem3utCWTn2U7QuFPwUXvGXhjZhE3MVojf S5n5ztYdna3b1kUDLz/DHCcaXoKoSvSUqPT1cyglDPTrrC8PITBHB2PtAoGBAJDU w4h4RENMAIxaQVZ/dtZE48VUEw41nVC/VRpaJoKTvd9mWPT1lnTuaeccJmU1EwL3 xKnf/c/eesZyUUW/srh1oyl9sQjqTsl5Tahjr4X+Ym9Ro4gQ26RAViiv+Ir3/JN/ uv8llOb6gQhOiT6myExF2WcwX7S26a/clijF1s5BAoGAOmJLv2mWRfibo6R/qt8f AAncMLalXb9TdB/K2pj6r999aP9JP5PV+Zbd7grjBBB6pG+FmpDJbtnhoYUTS5TA zsDyDLvwJIGpFA5CRpLXWrt1qj0Aoqjknq0CHpF8cxmejeG6o3F6WsDKhcvUHSdr eEN8XoB/noSGJ0mW8StwJVw= -----END PRIVATE KEY----- Protocol-ACME-1.01/t/test_cert_key.der000644 054744 001130 00000002302 12650211736 017164 0ustar00sludin000000 000000 00  *H 0CgfP8*4|DN [Cƶ5~h”QssDhAM ?.>>Zhe2Є=MlW@J; rFk&.6/ԭt2-8uqczȀ?Ɉ?ddD1`U5%(%y|H YA3Z.b- P?X 0"|4hJrUq&< =J;=L$A^*Yղ*aB(-L|6mSs##><*sK 5'2pY ۫tatKDvB)tKpC*>mJ$N^Kk ۴!sTuUC8.\װ82$ A\sxsMJĽ 'IlHk.%kfe,O;6 I7-E:Ov.e@)kBLj g@C䪍 X=w&܌KSNE 6j >`(/`%.B1in fG8WTzdpCevLY.G?+54_(E J#M: *S OҞ{A_Gi`S^GO%48caEtCb{nL?JTL5Ash&H@sve.G3MS~3F{B,,1 x~ ]ly4e/uxj1Ɍ[+&V񪝲%*Cؼg ?}PvOeceȥ+qW3 ZU}Ң4UPvxN`FR=ګw.Xiّ%Wzg2$fi.t(U+Pt٢G]oVkİ .]6JCY]@eQ@6Mv'8i;XI ,a*M U]g( e>A4X:凑5i+.ccG܍dl6Dhd0y,VSXc>rnrwWDiUProtocol-ACME-1.01/t/test_cert_key.pem000644 054744 001130 00000003250 12650211736 017176 0ustar00sludin000000 000000 -----BEGIN PRIVATE KEY----- MIIEvgIBADANBgkqhkiG9w0BAQEFAASCBKgwggSkAgEAAoIBAQDhQ/7UZ/JmUDi/ iPao7Co0fEROgPPS7akgW0P5lr6CxrY1l36UaLbgwpSg3w4aUXP/BHPm50Ro4qtB nubzyk0LxD/j6i7CPhc+8FpoZdMy0IQ9E01swhgRV9L74BJAF4yGF+pKqJw7DHJG lGuXJn+5oy42B73+/+ayyC/UrXQYt7PCMoi2LfuLqzjJdRxxY3ofmciAP/jJiLya P85kZETKMQaY5+dgVb+b0jWFJSjvGiWpeaSGfJoSA0gL3QD9uVlBtzO6EFoWLmIt CQDGUMs/WLGzPJljyIX7JpOHH1kOxHeWXMzuQ1eFqjePZxE+Cg3WMCJ8/ooCsZTj NB6A9/fFAgMBAAECggEAaErYwnJVsbTWcSbyPAcLCz21Sjs9p5xMvyRB9l4qWdWy KmG3QvKwKKMtuMVMfDbV422mU3MjIwQ+kaUF/DzfKuFzSwvzFg81J/iTgt4Rx+bu MnCrWf0Ks4zbq610BaRhdPvBh0tE+bmrdq3kmhhC7il0jaNL/bFwl7lDG84qf/4+ qG3VSookBQFOk16li9JL+msKjO7btOIhAalzVISrdQHoVa3+QzjzLlyO17ATizgy JJIN5PxBEa7c+RPo9n9couhzeHNN0u+BSojEvYINJ6EOkxxJ4WyHSJNrLtslhuRr 5AWw9a1m2mUsjuD5T66rFjuGNgrCSTeN1S1FHDqKAQKBgQDwnk92LmVApx4pxgKv axu80UJMarHdIGefsLUBQEPkqo2zCv7jzVjMPXfT7Cbk9tyMiqsfphLEy0vEU04f gpaGRX+pqg3yNhEBago+YLmlj8jLACjbH5MvYOEloi5CMZxpBcFuH+nyCRtmiUf/ gLo4V5rm2cjbG1StpXqRDmTbBQKBgQDvqnBDExplngWprXZMmuS9WcHNLqtHP8jT 2SuWkeTPNbcGNL5fgxC9pYfy1SjC8Bev3EUKSv1/6OEjTTrp9yAqUwarC0/Snsh7 QQdfEodHn2lgG9NTXsPaR8RPJaKR6TSFOKC6Y2FFsnRD4wbaYuH1ewRuTD+NSlT/ TDXllhTFwQKBgQDRQaxzaAfwgSYPSEAflHOr8wTIdmW2nC7iRwgzTVN+MwFGe0KO lJAsFyz15cMxjqrhotsNjB14fiCnXZdseeI0ZY6P2++C/Jgvdavw8aeiH3iNatcd McmMA6HqW7AFKyYOg83j2udW8aqdsrglsSrCQxXYvAAc5RjwZyA/tJfrjQKBgQCY pRh9UBR29k+rA2UeY2UeyKUr1vaWGaUCcQZXDzMJWq/ojv1VfffSojRVULh2eE7N 3mBGrv6IUj3aqxzD2XcuHdVYaYr8nc8Y2ZElV3q7/mcyJGbTab8aLq10r4a8oiim VSvhqtxQdNmiR12dCG/cVu66hWvQxLAgLl0BjjZKwQKBgB1DCAFZ6ByQkBrNXR2N QGVRQBE2wU23dqYno+44aYs77VgZlEkJAyxh4CqkTcfeDFVdwmcoIOdlPrpBNFjD +NbDOuWHkTVp6t8rqS4dj/djY+kaxu5HuNyNZL4BbPo2AURoZNgweSxWU7BYY7f6 GQXI5j5yuY62bnJ3hBRXRGlV -----END PRIVATE KEY----- Protocol-ACME-1.01/t/test_csr.der000644 054744 001130 00000001143 12650211736 016150 0ustar00sludin000000 000000 0_0G010U www.example.com0"0  *H 0 CgfP8*4|DN [Cƶ5~h”QssDhAM ?.>>Zhe2Є=MlW@J; rFk&.6/ԭt2-8uqczȀ?Ɉ?ddD1`U5%(%y|H YA3Z.b- P?X 0"|40  *H  ]ڷQ SΣW}q ? 6MZXaOh !4ܝq) iQWk { filename => "test_account_key", pem => $account_key_pem, der => $account_key_der }, csr => { filename => "test_csr", pem => $csr_pem, der => $csr_der }, cert_key => { filename => "test_cert_key", pem => $cert_key_pem, der => $cert_key_der }, }; sub pem2der { my ($pem) = @_; chomp $pem; $pem =~ s<.+?[\x0d\x0a]+><>s; $pem =~ s<[\x0d\x0a]+[^\x0d\x0a]+?\z><>s; return MIME::Base64::decode($pem); } sub which { my @path = File::Spec->path; my $bin = shift; while (my $p = shift @path) { my $candidate = File::Spec->catfile($p, $bin); return $candidate if -x $candidate; } return; } sub _write_key_files { for my $object ( keys %$test_objs ) { for my $format ( qw( pem der ) ) { my $fh = IO::File->new( "t/$test_objs->{$object}->{filename}.$format", "w" ) || die $!; print $fh $test_objs->{$object}->{$format}; $fh->close(); } } } 1; Protocol-ACME-1.01/lib/Protocol/000755 054744 001130 00000000000 13000266152 015723 5ustar00sludin000000 000000 Protocol-ACME-1.01/lib/Protocol/ACME/000755 054744 001130 00000000000 13000266152 016430 5ustar00sludin000000 000000 Protocol-ACME-1.01/lib/Protocol/ACME.pm000644 054744 001130 00000067726 13000266064 017012 0ustar00sludin000000 000000 package Protocol::ACME; use 5.007003; use strict; use warnings; our $VERSION = '1.01'; =head1 NAME Protocol::ACME - Interface to the Let's Encrypt ACME API =head1 VERSION Version 1.01 =head1 SYNOPSIS use Protocol::ACME; my @names = qw( www.example.com cloud.example.com ); my $challenges = { 'www.example.com' => Protocol::ACME::Challenge::SimpleSSH->new( { ssh_host => "host1", www_root => "~/www" } ), 'cloud.example.com' => Protocol::ACME::Challenge::SimpleSSH->new( { ssh_host => "home2", www_root => "/opt/local/www/htdocs" } ) }; eval { my $acme = Protocol::ACME->new( host => $host, account_key => $account_key_pem_or_der, ); $acme->directory(); $acme->register(); $acme->accept_tos(); for my $domain ( @names ) { $acme->authz( $domain ); $acme->handle_challenge( $challenges->{$domain} ); $acme->check_challenge(); $acme->cleanup_challenge( $challenges->{$domain} ); } my $cert = $acme->sign( $csr_file ); }; if ( $@ ) { die if !UNIVERSAL::isa($@, 'Protocol::ACME::Exception'); die "Error occurred: Status: $@->{status}, Detail: $@->{detail}, Type: $@->{type}\n"; } else { # do something appropriate with the DER encoded cert print "Success\n"; } =head1 DESCRIPTION The C is a class implementing an interface for the Let's Encrypt ACME API. The class handles the protocol details behind provisioning a Let's Encrypt certificate. =head1 CONSTRUCTOR METHODS The following constructor methods are available: =over 4 =item $acme = Protcol::ACME->new( %options ) This method constructs a new C object and returns it. Key/value pair arguments may be provided to set up the initial state. The may be passed in as a hash or a hashref. The following options correspond to attribute methods described below. Items marked with a * are required. KEY DEFAULT ----------- -------------------- *host undef account_key undef openssl undef ua HTTP::Tiny->new() loglevel error debug 0 mailto undef B: The API end point to connect to. This will generally be acme-staging.api.letsencrypt.org or acme-v01.api.letsencrypt.org B: The account private key in a scalar ref or filename. See C<$self->account_key> for details on this arguemtn. B: The path to openssl. If this option is used a local version of the openssl binary will be used for crypto operations rather than C. B: An HTTP::Tiny object customized as you see fit B: Set the loglevel to one of the C values. B: If set to non-zero this is a shortcut for C debug> B: This should be the email address that you want associated with your account. This is used my Let's Encrypt for expiration notification. =back =head2 METHODS =over =item account_key( $key_filename ) =item account_key( \$buffer ) =item account_key( \%explicit_args ) C will load a the private account key if it was not already loaded when the C object was constructed. There are three ways to call this: If the arg is a B it is assumed to be the filename of the key. C will throw an error if there are problems reading the file. If the arg is a B reference it is assumed to be a buffer that contains the KEY. If the arg is a B reference it contains named arguments. The arguments are: KEY DEFAUL DESC ----------- ----------- ------------------- filename undef The key Filename buffer undef Buffer containing the key format undef Explicitly state the format ( DER | PEM ) If both C and C are set the C argument will be ignored. If the format is not explcitly set C will look at the key and try and determine what the format it. =item load_key_from_disk( $key_path ) B Load a key from disk. Currently the key needs to be unencrypted. Callbacks for handling password protected keys are still to come. =item directory() Loads the directory from the ACME host. This call must be made first before any other calls to the API in order the bootstrap the API resource list. =item register( %args ) Call the new-reg resource and create an account associated with the loaded account key. If that key has already been registered this method will gracefully and silently handle that. Arguments that can be passed in: KEY DEFAULT ----------- -------------------- mailto undef B: See C for a desciption. This will override the value passed to new if any. =item accept_tos() In order to use the Let's Encrypt service, the account needs to accept the Terms of Service. This is provided in a link header in response to the new-reg ( or reg ) resource call. If the TOS have already been accepted as indicated by the reg structure returned by the API this call will be a noop. =item authz( $domain ) C needs to be called for each domain ( called identifiers in ACME speak ) in the certificate. This included the domain in the subject as well as the Subject Alternate Name (SAN) fields. Each call to C will result in a challenge being issued from Let's Encrypt. These challenges need to be handled individually. =item handle_challenge( $challenge_object ) C is called for each challenge issued by C. The challenge object must be a subclass of C which implements a 'handle' method. This objects handle method will be passed three arguments and is expected to fulfill the preconditions for the chosen challenge. The three areguments are: fingerprint: the sha256 hex digest of the account key token: the challenge token url: the url returned by the challenge Fully describing how to handle every challenge type of out of the scope of this documentation ( at least for now ). Two challenge classes have been included for reference: C is initialized with the ssh host name and the www root for the web server for the http-01 challenge. It will ssh to the host and create the file in the correct location for challenge fulfillment. C is initialized with just the www root for the web server for the http-01 challenge. It will simply create the challenge file in the correct place on the local filesystem. C is intended to be run in an interactive manner and will stop and prompt the user with the relevant information so they can fulfill the challenge manually. but below is an example for handling the simpleHTTP ( http-01 ) challenge. =item check_challenge() Called after C. This will poll the challenge status resource and will return when the state changes from 'pending'. =item cleanup_challenge() Called after C to remove the challenge files. =item $cert = sign( $csr_filename ) =item $cert = sign( \$buffer ) =item $cert = sign( \%explicit_args ) Call C after the challenge for each domain ( itentifier ) has been fulfilled. There are three ways to call this: If the arg is a B it is assumed to be the filename of the CSR. C will throw an error if there are problems reading the file. If the arg is a B reference it is assumed to be a buffer that contains the CSR. If the arg is a B reference it contains named arguments. The arguments are: KEY DEFAUL DESC ----------- ----------- ------------------- filename undef The CSR Filename buffer undef Buffer containing the CSR format undef Explicitly state the format ( DER | PEM ) If both C and C are set the C argument will be ignored. If the format is not explcitly set Protocol::ACME will look at the CSR and try and determine what the format it. On success C will return the DER encoded signed certificate. =item $cert_chain = chain() After C has been called and a cert successfully created, C will fetch and return the DER encoded certificate issuer. =item revoke( $certfile ) Call C to revoke an already issued certificate. C<$certfile> must point the a DER encoded form of the certificate. =item recovery_key() LE does not yet support recovery keys. This method will die when called. =back =cut package Protocol::ACME; use strict; use warnings; use Protocol::ACME::Exception; use Protocol::ACME::Utils; use Crypt::Format; use Crypt::RSA::Parse (); use MIME::Base64 qw( encode_base64url decode_base64url decode_base64 encode_base64 ); use HTTP::Tiny; use JSON; use Digest::SHA qw( sha256 ); use Carp; my $USERAGENT = "Protocol::ACME v$VERSION"; my $NONCE_HEADER = "replay-nonce"; sub new { my $class = shift; my $self = {}; bless $self, $class; $self->_init( @_ ); return $self; } sub _init { my $self = shift; my $args; if ( ref $_[0] eq "HASH" ) { $args = $_[0]; } else { %$args = @_; } # TODO: There are more elegant and well baked ways to take care of the # parameter handling that I am doing here $self->{host} = $args->{host} if exists $args->{host}; $self->{ua} = $args->{ua} if exists $args->{ua}; $self->{openssl} = $args->{openssl} if exists $args->{openssl}; $self->{debug} = $args->{debug} if exists $args->{debug}; $self->{loglevel} = exists $args->{loglevel} ? $args->{loglevel} : "error"; $self->{contact}->{mailto} = $args->{mailto} if exists $args->{mailto}; if ( $self->{debug} ) { $self->{loglevel} = "debug"; } if ( ! exists $self->{ua} ) { $self->{ua} = HTTP::Tiny->new( agent => $USERAGENT, verify_SSL => 1 ); } if ( ! exists $self->{host} ) { _throw( detail => "host parameter is required for Protocol::ACME::new" ); } $self->{log} = $args->{'logger'} || do { require Log::Any::Adapter; Log::Any::Adapter->set('+Protocol::ACME::Logger', log_level => $self->{loglevel}); Log::Any->get_logger; }; if ( exists $args->{account_key} ) { $self->account_key( $args->{account_key} ); } $self->{links}->{directory} = "https://" . $self->{host} . '/directory'; $self->{nonce} = undef; } sub _throw { my (@args) = @_; if ( scalar(@_) == 1 ) { @args = ( detail => $_[0] ); } croak ( Protocol::ACME::Exception->new( { @args } ) ); } sub load_key { my ($self, $keystring) = @_; return $self->account_key( \$keystring ); } sub load_key_from_disk { my $self = shift; my $path = shift; return $self->account_key($path); } sub account_key { my $self = shift; my $key = shift; my %args = ( filename => undef, buffer => undef, format => undef ); if ( ! ref $key ) { $args{filename} = $key; if ( ! -f $key ) { _throw( "account_key file $key does not exist" ); } } elsif( ref $key eq "SCALAR" ) { $args{buffer} = $$key; } else { @args{ keys %$key } = values %$key; } if ( $args{filename} ) { $args{buffer} = _slurp( $args{filename} ); if ( ! $args{buffer} ) { _throw( "Could not load the account key from file $args{filename}: $!" ); } } if ( ! $args{buffer} ) { _throw( "Either an account key buffer or filename must be passed into account_key" ); } if ( ! $args{format} ) { $args{format} = Protocol::ACME::Utils::looks_like_pem( $args{buffer} ) ? "PEM" : "DER"; } my $keystring = $args{buffer}; # TODO: This should detect/handle PKCS8-formatted private keys as well. if ( $args{format} eq "DER" ) { $keystring = Crypt::Format::der2pem( $keystring, "RSA PRIVATE KEY" ); } if ( exists $self->{openssl} ) { require Protocol::ACME::Key; $key = Protocol::ACME::Key->new( keystring => $keystring, openssl => $self->{openssl} ); } else { eval { require Crypt::OpenSSL::RSA; require Crypt::OpenSSL::Bignum; }; if ( $@ ) { die "Invoked usage requires Crypt::OpenSSL::RSA and Crypt::OpenSSL::Bignum. " . "To avoid these dependencies use the openssl parameter when creating the " . "Protocol::ACME object. This will use a native openssl binary instead."; } eval { $key = Crypt::OpenSSL::RSA->new_private_key($keystring); }; if ( $@ ) { _throw( "Error creating a key structure from the account key" ); } } if ( ! $key ) { _throw( "Could not load account key into key structure" ); } $key->use_sha256_hash(); $self->{key}->{key} = $key; my ( $n_b64, $e_b64 ) = map { encode_base64url(_bigint_to_binary($_)) } $key->get_key_parameters(); $self->{key}->{n} = $n_b64; $self->{key}->{e} = $e_b64; $self->{log}->debug( "Private key loaded" ); } sub directory { my $self = shift; my $resp = $self->_request_get( $self->{links}->{directory} ); if ( $resp->{status} != 200 ) { _throw( detail => "Failed to fetch the directory for $self->{host}", resp => $resp ); } my $data = _decode_json( $resp->{content} ); @{$self->{links}}{keys %$data} = values %$data; $self->{log}->debug( "Let's Encrypt Directories loaded." ); } # # Register the account or load the reg url for an existing account ( new-reg or reg ) # sub register { my $self = shift; my %args = @_; my $obj = {}; $obj->{resource} = 'new-reg'; if ( exists $args{mailto} ) { push @{$obj->{contact}}, "mailto:$args{mailto}"; } elsif ( exists $self->{contact}->{mailto} ) { push @{$obj->{contact}}, "mailto:$self->{contact}->{mailto}"; } my $msg = _encode_json( $obj ); my $json = $self->_create_jws( $msg ); $self->{log}->debug( "Sending registration message" ); my $resp = $self->_request_post( $self->{links}->{'new-reg'}, $json ); if ( $resp->{status} == 409 ) { $self->{links}->{'reg'} = $resp->{headers}->{'location'}; $self->{log}->debug( "Known key used" ); $self->{log}->debug( "Refetching with location URL" ); my $json = $self->_create_jws( _encode_json( { "resource" => 'reg' } ) ); $resp = $self->_request_post( $self->{links}->{'reg'}, $json ); if ( $resp->{status} == 202 ) { my $links = _link_to_hash( $resp->{headers}->{'link'} ); @{$self->{links}}{keys %$links} = values %$links; } else { _throw( %{ $self->{content} } ); } } elsif ( $resp->{status} == 201 ) { my $links = _link_to_hash( $resp->{headers}->{'link'} ); @{$self->{links}}{keys %$links} = values %$links; $self->{links}->{'reg'} = $resp->{headers}->{'location'}; $self->{log}->debug( "New key used" ); } else { _throw( %{ $self->{content} } ); } $self->{reg} = $self->{content}; } sub recovery_key { # LE does not yet support the key recovery resource # the below can be considered debug code die "Let's Encrypt does not yet support key recovery"; my $self = shift; my $keyfile = shift; my $pem = _slurp( $keyfile ); _throw( "recovery_key: $keyfile: $!" ) if ! $pem; my $url = "https://acme-staging.api.letsencrypt.org/acme/reg/101834"; my $der = Crypt::Format::pem2der( $pem ); my $pub = Crypt::PK::ECC->new( \$der ); my $public_json_text = $pub->export_key_jwk('public'); my $hash = $pub->export_key_jwk( 'public', 1 ); my $msg = { "resource" => "reg", "recoveryToken" => { "client" => { "kty" => "EC", "crv" => "P-256", "x" => $hash->{x}, "y" => $hash->{y} } } }; my $json = $self->_create_jws( _encode_json($msg) ); my $resp = $self->_request_post( $url, $json ); # TODO: This is not complete } sub accept_tos { my $self = shift; if ( exists $self->{reg}->{agreement} ) { $self->{log}->debug( "TOS already accepted. Skipping" ); return; } $self->{log}->debug( "Accepting TOS" ); # TODO: check for existance of terms-of-service link # TODO: assert on reg url being present my $msg = _encode_json( { "resource" => "reg", "agreement" => $self->{links}->{'terms-of-service'}, "key" => { "e" => $self->{key}->{e}, "kty" => "RSA", "n" => $self->{key}->{n} } } ); my $json = $self->_create_jws( $msg ); my $resp = $self->_request_post( $self->{links}->{'reg'}, $json ); if ( $resp->{status} == 202 ) { $self->{log}->debug( "Accepted TOS" ); } else { _throw( %{ $self->{content} } ); } } sub revoke { my $self = shift; my $certfile = shift; $self->{log}->debug( "Revoking Cert" ); my $cert = _slurp( $certfile ); if ( ! $cert ) { _throw("revoke: Could not load cert from $certfile: $!"); } my $msg = _encode_json( { "resource" => "revoke-cert", "certificate" => encode_base64url( $cert ) } ); my $json = $self->_create_jws( $msg ); my $resp = $self->_request_post( $self->{links}->{'revoke-cert'}, $json ); if ( $resp->{status} != 200 ) { _throw( %{ $self->{content} } ); } } sub authz { my $self = shift; my $domain = shift; $self->{log}->debug( "Sending authz message for $domain" ); # TODO: check for 'next' URL and that is it authz my $msg = _encode_json( { "identifier" => { "type" => "dns", "value" => $domain }, "resource" => "new-authz" } ); my $json = $self->_create_jws( $msg ); my $resp = $self->_request_post( $self->{links}->{next}, $json ); if ( $resp->{status} == 201 ) { $self->{challenges} = $self->{content}->{challenges}; } else { _throw( %{ $self->{content} } ); } } sub handle_challenge { my $self = shift; my $challenge = shift; my @args = @_; my $key = $self->{key}; my $jwk = _encode_json( { "e" => $key->{e}, "kty" => "RSA", "n" => $key->{n} } ); my $token; my $challenge_url; # TODO: this is feeling hardcoded and messy - and fragile # how do we handle other auth challenges? # This is hardcoded for http-01 for ( @{$self->{challenges}} ) { if ( $_->{type} eq "http-01" ) { $token = $_->{token}; $challenge_url = $_->{uri}; } } my $fingerprint = encode_base64url( sha256( $jwk ) ); $self->{log}->debug( "Handing challenge for token: $token.$fingerprint" ); my $ret = $challenge->handle( $token, $fingerprint, @args ); if ( $ret == 0 ) { $self->{fingerprint} = $fingerprint; $self->{token} = $token; $self->{links}->{challenge} = $challenge_url; } else { _throw( status => 0, detail => "Error in handling challenge: $ret", type => "challenge_exec" ); } } sub check_challenge { my $self = shift; my $msg = _encode_json( { "resource" => "challenge", "keyAuthorization" => $self->{token} . '.' . $self->{fingerprint} } ); my $json = $self->_create_jws( $msg ); my $resp = $self->_request_post( $self->{links}->{challenge}, $json ); my $status_url = $self->{content}->{uri}; # TODO: check for failure of challenge check # TODO: check for other HTTP failures $self->{log}->debug( "Polling for challenge fulfillment" ); while( 1 ) { $self->{log}->debug( "Status: $self->{content}->{status}" ); if ( $self->{content}->{status} eq "pending" ) { sleep(2); $resp = $self->_request_get( $status_url ); } elsif ( $self->{content}{status} eq "invalid" ) { _throw(%{ $self->{content} }); } else { last; } } } sub cleanup_challenge { my $self = shift; my $challenge = shift; return $challenge->cleanup(); } sub sign { my $self = shift; my $csr = shift; $self->{log}->debug( "Signing" ); my %args = ( filename => undef, buffer => undef, format => undef ); if ( ! ref $csr ) { $args{filename} = $csr; } elsif( ref $csr eq "SCALAR" ) { $args{buffer} = $$csr; } else { @args{keys %$csr} = values %$csr; } if ( $args{filename} ) { $args{buffer} = _slurp( $args{filename} ); if ( ! $args{buffer} ) { _throw( "Could not load CSR from file $args{filename}" ); } } if ( ! $args{buffer} ) { _throw( "Either a buffer or filename must be passed to sign" ); } if ( ! $args{format} ) { $args{format} = Protocol::ACME::Utils::looks_like_pem( $args{buffer} ) ? "PEM" : "DER"; } my $der = $args{format} eq "DER" ? $args{buffer} : Crypt::Format::pem2der( $args{buffer} ); my $msg = _encode_json( { "resource" => "new-cert", "csr" => encode_base64url( $der ) } ); my $json = $self->_create_jws( $msg ); my $resp = $self->_request_post( $self->{links}->{'new-cert'}, $json, 1 ); if ( $resp->{status} != 201 ) { _throw( %{_decode_json($resp->{content}) } ); } my $links = _link_to_hash( $resp->{headers}->{'link'} ); $self->{links}->{chain} = $links->{up} if exists $links->{up}; $self->{links}->{cert} = $resp->{headers}->{location} if exists $resp->{headers}->{location}; $self->{cert} = $resp->{content}; return $self->{cert}; } sub chain { my $self = shift; if ( ! exists $self->{links}->{chain} ) { _throw( "URL for the cert chain missing. Has sign() been called yet?" ); } my $resp = $self->_request_get( $self->{links}->{chain}, 1 ); if ( $resp->{status} != 200 ) { _throw( detail => "Error received fetching the certificate chain", status => $resp->{status} ); } $self->{chain} = $resp->{content}; return $self->{chain}; } ############################################################# ### "Private" functions sub _request_get { my $self = shift; my $url = shift; my $nodecode = shift || 0; my $resp = $self->{ua}->get( $url ); $self->{nonce} = $resp->{headers}->{$NONCE_HEADER}; $self->{json} = $resp->{content}; #Exception here should be fatal. $self->{content} = undef; $self->{content} = _decode_json( $resp->{content} ) unless $nodecode; $self->{response} = $resp; return $resp; } sub _request_post { my $self = shift; my $url = shift; my $content = shift; my $nodecode = shift || 0; my $resp = $self->{ua}->post( $url, { content => $content } ); $self->{nonce} = $resp->{headers}->{$NONCE_HEADER}; $self->{json} = $resp->{content}; #Let exception from decode_json() propagate: #if we failed to decode the JSON, that’s a show-stopper. $self->{content} = undef; $self->{content} = _decode_json( $resp->{content} ) unless $nodecode; $self->{response} = $resp; return $resp; } sub _create_jws { my $self = shift; my $msg = shift; return _create_jws_internal( $self->{key}, $msg, $self->{nonce} ); } ############################################################# ### Helper functions - not class methods sub _slurp { my $filename = shift; open my $fh, '<', $filename or return undef; sysread( $fh, my $content, -s $fh ) or return undef; return $content; } sub _link_to_hash { my $arrayref = shift; my $links; return {} unless $arrayref; if ( ! ref $arrayref ) { $arrayref = [ $arrayref ]; } for my $link ( @$arrayref ) { my ( $value, $key ) = split( ';', $link ); my ($url) = $value =~ /<([^>]*)>/; my ($rel) = $key =~ /rel=\"([^"]*)"/; if ( $url && $rel ) { $links->{$rel} = $url; } else { # TODO: Something wonderful } } return $links; } sub _bigint_to_binary { my ( $bigint ) = @_; # TODO: Inelegant hack to deal with different Bignum implementations my $hex; if ( UNIVERSAL::isa( $bigint, "Math::BigInt" ) ) { $hex = substr( $bigint->as_hex(), 2 ); #Prefix a 0 as needed to get an even number of digits. if (length($hex) % 2) { substr( $hex, 0, 0, 0 ); } return pack 'H*', $hex; } else { $bigint->to_bin(); } } sub _create_jws_internal { my $key = shift; my $msg = shift; my $nonce = shift; my $protected_header = '{"nonce": "' . $nonce . '"}'; my $sig = encode_base64url( $key->{key}->sign( encode_base64url($protected_header) . "." . encode_base64url($msg) ) ); my $jws = { header => { alg => "RS256", jwk => { "e" => $key->{e}, "kty" => "RSA", "n" => $key->{n} } }, protected => encode_base64url( $protected_header ), payload => encode_base64url( $msg ), signature => $sig }; my $json = _encode_json( $jws ); return $json; } sub _decode_json { my $ref = shift; my $json = ""; eval { $json = JSON->new->allow_nonref->decode($ref); }; return $json; } sub _encode_json { my $ref = shift; # my $json = JSON->new(); # $json->canonical(); # return $json->encode($ref); return JSON->new->canonical->encode($ref); } =head1 AUTHOR Stephen Ludin, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 REPOSITORY https://github.com/sludin/Protocol-ACME =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Protocol::ACME You can also look for information at: =over 4 =item * RT: CPAN's request tracker (report bugs here) L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 CONTRIBUTORS Felipe Gasper, C<< >> =head1 ACKNOWLEDGEMENTS =head1 LICENSE AND COPYRIGHT Copyright 2015 Stephen Ludin. This program is free software; you can redistribute it and/or modify it under the terms of the the Artistic License (2.0). You may obtain a copy of the full license at: L Any use, modification, and distribution of the Standard or Modified Version 1.01 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 1; # End of Protocol::ACME Protocol-ACME-1.01/lib/Protocol/ACME/Challenge/000755 054744 001130 00000000000 13000266152 020312 5ustar00sludin000000 000000 Protocol-ACME-1.01/lib/Protocol/ACME/Challenge.pm000644 054744 001130 00000000261 13000262412 020642 0ustar00sludin000000 000000 package Protocol::ACME::Challenge; use strict; use warnings; =head1 NAME Protocol::ACME::Challenge - Empty base class for ACME Challenges =cut our $VERSION = '1.01'; 1; Protocol-ACME-1.01/lib/Protocol/ACME/Exception.pm000644 054744 001130 00000001334 13000262412 020720 0ustar00sludin000000 000000 package Protocol::ACME::Exception; use strict; use warnings; our $VERSION = '1.01'; # very simple stringification ... make this # more elaborate according to taste use overload ('""' => \&stringify); sub stringify { my $self = shift; require Data::Dumper; return ref($self).' error: '.Data::Dumper::Dumper($self); } sub new { my $class = shift; my $error = shift; my $self = { status => 0, detail => "", type => "unknown" }; if ( ref $error eq "HASH" ) { @$self{keys %$error} = values %$error; } elsif ( ref $error ) { $self->{detail} = "double error: bad arg ($error) passed to exception constructor"; } else { $self->{detail} = $error; } return bless $self, $class; } 1; Protocol-ACME-1.01/lib/Protocol/ACME/Key.pm000644 054744 001130 00000002417 13000262412 017515 0ustar00sludin000000 000000 package Protocol::ACME::Key; # A shim that imitates Crypt::OpenSSL::RSA. use strict; use warnings; our $VERSION = '1.01'; use Crypt::RSA::Parse; use Math::BigInt (); use Protocol::ACME::Utils; sub new { my ($class, %opts) = @_; my $key = Crypt::RSA::Parse::private($opts{'keystring'}); my $self = { _keystring => $opts{'keystring'}, _openssl_bin => $opts{'openssl'}, _private_key => $key, e => Math::BigInt->new( $key->publicExponent() ), n => $key->modulus(), }; return bless $self, $class; } sub use_sha256_hash { # NOOP for compatibility with Crypt::OpenSSL::RSA } sub get_key_parameters { my $self = shift; return ( $self->{n}, $self->{e} ); } sub sign { my ($self, $payload) = @_; #TODO: Use an available SHA256-digest module, if any. $self->{'_openssl'} ||= do { require Protocol::ACME::OpenSSL; Protocol::ACME::OpenSSL->new($self->{'_openssl_bin'}); }; require File::Temp; my $fh = File::Temp->new(); my $kpath = $fh->filename(); print {$fh} $self->{'_keystring'} or die "write($kpath) failed: $!"; close $fh or die "close($kpath) failed: $!"; return $self->{'_openssl'}->run( command => [ 'dgst', '-sha256', '-binary', '-sign' => $kpath, ], stdin => $payload, ); } 1; Protocol-ACME-1.01/lib/Protocol/ACME/Logger.pm000644 054744 001130 00000002633 13000262412 020204 0ustar00sludin000000 000000 package Protocol::ACME::Logger; use strict; use warnings; use Log::Any::Adapter; use base qw/Log::Any::Adapter::Base/; use Time::HiRes qw( gettimeofday ); our $VERSION = '1.01'; my %LOG_LEVELS = ( emergency => 0, alert => 1, critical => 2, fatal => 2, crit => 2, err => 2, error => 3, warn => 4, warning => 4, notice => 5, inform => 6, info => 6, debug => 7, trace => 8, ); sub init { my ($self) = @_; if ( exists $self->{log_level} ) { $self->{log_level} = $LOG_LEVELS{lc($self->{log_level})} unless $self->{log_level} =~ /^\d+$/; } else { $self->{log_level} = $LOG_LEVELS{trace}; } } foreach my $method (keys %LOG_LEVELS) { no strict 'refs'; my $method_level = $LOG_LEVELS{$method}; *{$method} = sub { my ( $self, $text ) = @_; return if $method_level > $self->{log_level}; my ( $sec, $usec ) = gettimeofday(); printf STDOUT "# %d.%06d %s\n", $sec, $usec, $text; }; my $detection_method = 'is_' . $method; *{$detection_method} = sub { return !!( $method_level <= $_[0]->{log_level} ); }; } 1; Protocol-ACME-1.01/lib/Protocol/ACME/OpenSSL.pm000644 054744 001130 00000003340 13000262412 020244 0ustar00sludin000000 000000 package Protocol::ACME::OpenSSL; use strict; use warnings; our $VERSION = '1.01'; sub new { my ( $class, $openssl_bin ) = @_; return bless { _bin => $openssl_bin }, $class; } sub run { my ($self, %opts) = @_; my @cmd = @{ $opts{'command'} }; local( $!, $^E ); my ($crdr, $pwtr) = _pipe_or_die() if length $opts{'stdin'}; my ($perr, $cerr) = _pipe_or_die(); my ($prdr, $cwtr) = _pipe_or_die(); my $pid = fork(); if (!$pid) { die "Failed to fork(): $!" if !defined $pid; close $pwtr; close $perr; close $prdr; if (length $opts{'stdin'}) { open \*STDIN, '<&=' . fileno($crdr) or do { warn "dup STDIN failed: $!"; exit $!; }; } open \*STDOUT, '>&=' . fileno($cwtr) or do { warn "dup STDOUT failed: $!"; exit $!; }; open \*STDERR, '>&=' . fileno($cerr) or do { warn "dup STDERR failed: $!"; exit $!; }; exec {$self->{_bin}} $self->{_bin}, @cmd or do { warn "exec($self->{_bin}) failed: $!"; exit $!; }; } close $crdr; close $cwtr; close $cerr; if (length $opts{'stdin'}) { print {$pwtr} $opts{'stdin'} or die "Failed to write to $self->{_bin}: $!"; } close $pwtr or die "close() on pipe to $self->{_bin} failed: $!"; my ($output, $error) = ( q<>, q<> ); $output .= $_ while <$prdr>; $error .= $_ while <$perr>; close $prdr; close $perr; waitpid $pid, 0; if ($?) { my $failure = ($? & 0xff) ? "signal $?" : sprintf("error %d", $? >> 8); die "$error\n$self->{_bin} failed: $failure"; } return $output; } sub _pipe_or_die { pipe( my ($rdr, $wtr) ) or die "pipe() failed $!"; return ($rdr, $wtr); } 1; # End of Protocol::ACME::OpenSSL Protocol-ACME-1.01/lib/Protocol/ACME/Utils.pm000644 054744 001130 00000000261 13000262412 020060 0ustar00sludin000000 000000 package Protocol::ACME::Utils; use strict; use warnings; our $VERSION = '1.01'; sub looks_like_pem { my ($str) = @_; return (substr($str, 0, 4) eq '----') ? 1 : 0; } 1; Protocol-ACME-1.01/lib/Protocol/ACME/Challenge/LocalFile.pm000644 054744 001130 00000013131 13000262412 022474 0ustar00sludin000000 000000 package Protocol::ACME::Challenge::LocalFile; =head1 NAME Protocol::ACME::Challenge::LocalFile - Challenge handler for simpleHttp via a local file =head1 SYNOPSIS use Protocol::ACME::Challenge::LocalFile; my $args = { 'www_root' => "/path/to/htdocs/or/equivalent" }; my $challenge = Protocol::ACME::Challenge::LocalFile->new( $args ); ... $acme->handle_challenge( $challenges->{$domain} ); =head1 DESCRIPTION The C class is a handler intended to be run when the ACME script is run on the same local machine as the web server. This is a logical choice to use for self contained web server / Let's Encypt integration. =head1 CONSTRUCTOR METHODS The following constructor methods are available: =over 4 =item $acme = Protcol::ACME::Challenge::LocalFile->new( %options ) This method constructs a new C object and returns it. Key/value pair arguments may be provided to set up the initial state. The may be passed in as a hash or a hashref. The following options correspond to attribute methods described below. Items markes with a * are required. KEY DEFAULT ----------- -------------------- *www_root path to web root that will handle the HTTP challenge =back =head2 METHODS =over =item handle( $challenge, $fingerprint ) This is intended to be called indirectly via the ACME driver class. C will take care of all of the conditions necessary to satisfy the challenge sent by Let's Encrypt. =item cleanup C will remove the challenge file. =back =cut use strict; use warnings; use parent qw ( Protocol::ACME::Challenge ); use Carp; use IO::File; our $VERSION = '1.01'; sub new { my $class = shift; my $self = {}; bless $self, $class; $self->_init( @_ ); return $self; } sub _init { my $self = shift; my $args; if ( @_ == 1 ) { $args = shift; if ( ref $args ne "HASH" ) { croak "Must pass a hash or hashref to challenge constructor"; } } else { $args = \%_; } for my $required_arg ( qw ( www_root ) ) { if ( ! exists $args->{$required_arg} ) { croak "Require arg $required_arg missing from chalenge constructor"; } else { $self->{$required_arg} = $args->{$required_arg}; } } $self->{filename} = undef; } sub handle { my $self = shift; my $challenge = shift; my $fingerprint = shift; # TODO: put the 'well known path' in a global variable somewhere if (not -d $self->{www_root}){ carp "$self->{www_root} does not exist\n"; } # if we are root this will make us into the correct user for the site my ($uid,$gid) = (stat $self->{www_root})[4,5]; local $) = $gid;local $> = $uid; umask 022; my $dir = "$self->{www_root}/.well-known/acme-challenge"; system "mkdir","-p",$dir; my $filename = "$dir/$challenge"; my $content = "$challenge.$fingerprint"; my $fh = IO::File->new( $filename, "w" ); if ( ! $fh ) { carp "Could not open $filename for write"; return 1; } print $fh $content; $fh->close(); $self->{filename} = $filename; return 0; } sub cleanup { my $self = shift; unlink $self->{filename} if defined $self->{filename}; } =head1 AUTHOR Stephen Ludin, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS =head1 LICENSE AND COPYRIGHT Copyright 2015 Stephen Ludin. This program is free software; you can redistribute it and/or modify it under the terms of the the Artistic License (2.0). You may obtain a copy of the full license at: L 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 1; Protocol-ACME-1.01/lib/Protocol/ACME/Challenge/Manual.pm000644 054744 001130 00000010442 13000262412 022061 0ustar00sludin000000 000000 package Protocol::ACME::Challenge::Manual; =head1 NAME Protocol::ACME::Challenge::Manual - Challenge handler for simpleHttp via manual setup =head1 SYNOPSIS use Protocol::ACME::Challenge::Manual; my $challenge = Protocol::ACME::Challenge::Manual->new(); ... $acme->handle_challenge( $challenge ); =head1 DESCRIPTION The C class is a handler intended to be run interactively. It will return the challenge and fingerprint to the user and wait until the user has taken care of the required conditions. =head1 CONSTRUCTOR METHODS The following constructor methods are available: =over 4 =item $acme = Protcol::ACME::Challenge::Manual->new() This method constructs a new C object and returns it. =back =head2 METHODS =over =item handle( $challenge, $fingerprint ) This is intended to be called indirectly via the ACME driver class. C will prompt the user with the challenge and fingerprint and wait for the user to indicate that challenge conditions are met. =back =cut use strict; use warnings; use parent qw ( Protocol::ACME::Challenge ); use Carp; use IO::File; our $VERSION = '1.01'; sub new { my $class = shift; my $self = {}; bless $self, $class; $self->_init( @_ ); return $self; } sub _init { my $self = shift; } sub handle { my $self = shift; my $challenge = shift; my $fingerprint = shift; my $filename = $challenge; my $content = "$challenge.$fingerprint"; print "Challenge filename: $challenge\n"; print "Challenge text: $content\n"; print "\n"; print "Create a file with the above filename and content under /.well-known/acme-challenge\n"; print "where is your web server's document root. Let's Encrypt will make an HTTP request\n"; print "for this file and confirm that it has the correct content."; print "\n"; print "Hit return when the file is in place: "; my $x = ; return 0; } =head1 AUTHOR Stephen Ludin, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS =head1 LICENSE AND COPYRIGHT Copyright 2015 Stephen Ludin. This program is free software; you can redistribute it and/or modify it under the terms of the the Artistic License (2.0). You may obtain a copy of the full license at: L 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 1; Protocol-ACME-1.01/lib/Protocol/ACME/Challenge/SimpleSSH.pm000644 054744 001130 00000012655 13000262412 022463 0ustar00sludin000000 000000 package Protocol::ACME::Challenge::SimpleSSH; =head1 NAME Protocol::ACME::Challenge::SimpleSSH - Challenge handler for simpleHttp via SSH =head1 SYNOPSIS use Protocol::ACME::Challenge::SimpleSSH; my $args = { 'www_root' => "/path/to/htdocs/or/equivalent", 'ssh_host' => "ssh.example.com" }; my $challenge = Protocol::ACME::Challenge::SimpleSSH->new( $args ); ... $acme->handle_challenge( $challenges->{$domain} ); =head1 DESCRIPTION The C class is a handler intended to be run when the ACME script is run on a different machine than the web server. It will create the challenge file in the designated location via SSH. Note that there is no attempt to escalate privleges so the location will need to be writabel by the ssh user. =head1 CONSTRUCTOR METHODS The following constructor methods are available: =over 4 =item $acme = Protcol::ACME::Challenge::SimpleSSH->new( %options ) This method constructs a new C object and returns it. Key/value pair arguments may be provided to set up the initial state. The may be passed in as a hash or a hashref. The following options correspond to attribute methods described below. Items markes with a * are required. KEY DEFAULT ----------- -------------------- *www_root Path to web root that will handle the HTTP challenge *ssh_host Hostname of the web server for ssh access =back =head2 METHODS =over =item handle( $challenge, $fingerprint ) This is intended to be called indirectly via the ACME driver class. C will take care of all of the conditions necessary to satisfy the challenge sent by Let's Encrypt. =item cleanup C will remove the challenge file. =back =cut use strict; use warnings; use parent qw ( Protocol::ACME::Challenge ); use Carp; our $VERSION = '1.01'; sub new { my $class = shift; my $self = {}; bless $self, $class; $self->_init( @_ ); return $self; } sub _init { my $self = shift; my $args; if ( @_ == 1 ) { $args = shift; if ( ref $args ne "HASH" ) { croak "Must pass a hash or hashref to challenge constructor"; } } else { $args = \%_; } for my $required_arg ( qw ( ssh_host www_root ) ) { if ( ! exists $args->{$required_arg} ) { croak "Require arg $required_arg missing from chalenge constructor"; } else { $self->{$required_arg} = $args->{$required_arg}; } } $self->{filename} = undef; } sub handle { my $self = shift; my $challenge = shift; my $fingerprint = shift; my $dir = "$self->{www_root}/.well-known/acme-challenge"; my $filename = "$dir/$challenge"; my @cmd = ('ssh', '-q', $self->{ssh_host}, "mkdir -p '$dir' && echo '$challenge.$fingerprint' > '$filename'"); system @cmd; my $ret = $?; $self->{filename} = $filename; return $ret == 0 ? 0 : 1; } sub cleanup { my $self = shift; my @cmd = ('ssh', '-q', $self->{ssh_host}, "rm -f '$self->{filename}'"); system @cmd; } =head1 AUTHOR Stephen Ludin, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 ACKNOWLEDGEMENTS =head1 LICENSE AND COPYRIGHT Copyright 2015 Stephen Ludin. This program is free software; you can redistribute it and/or modify it under the terms of the the Artistic License (2.0). You may obtain a copy of the full license at: L 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 1; Protocol-ACME-1.01/examples/client.pl000644 054744 001130 00000012336 12705275607 017032 0ustar00sludin000000 000000 use strict; use warnings; use Protocol::ACME; use Protocol::ACME::Challenge::Manual; use Protocol::ACME::Challenge::SimpleSSH; use Protocol::ACME::Challenge::LocalFile; use IO::File; use Data::Dumper; my $host = "acme-staging.api.letsencrypt.org"; # LE Staging Server #my $host = "acme-v01.api.letsencrypt.org"; # LE Production Server # Note: calls to the LE production server are rate limited. Use it only # after you have fully debugged your script against staging # IMPORTANT: This script is not intended to be a fully functional client # for handling the creation and renewal of certificates. Its # goal is to demonstrate the usage of the Protocol::ACME library. # For a fully functional client built on Protocol::ACME I recommend # looking at Tobias Oetiker's AcmeFetch client: # https://github.com/oetiker/AcmeFetch # # Usage: # Generate a new private key for the Let's Encrypt account. For example: # $ openssl genrsa -out account_key.pem 2048 # # Generate a new private key for the certificate. For example: # $ openssl genrsa -out cert_key.pem 2048 # # Generate a certificate signing request (CSR). For example (for a single domain cert): # $ openssl req -new -sha256 -key cert_key.pem -outform der -subj "/CN=cloud.example.org" > csr.der # # Generating a CSR for a SAN cert ( multiple domains ) is a bit more work. Grab a version # of openssl.cnf and add the following: # # [SAN] # subjectAltName=DNS:domain1.example.com,DNS:domain2.example.com # # and then generate with something like: # # $ openssl req -new -out test.csr -outform der -key cert_key.pem -config openssl.cnf \ # -reqexts SAN -subj "/CN=domain.example.com" -sha256 # # This will create a cert with three domains. domain.example.com will be in the subject and # domain1.example.com and domain2.example.com will be in the SAN extension. # # Tailor the below script to your needs # my $account_key_file = shift; my $csr_file = shift; my $cert_file = shift; my $names = shift; if ( ! $csr_file or ! $account_key_file or ! $cert_file ) { die "Usage: perl foo.pl []"; } my @names; if ( ! $names ) { require Convert::X509; @names = pull_identifiers_from_csr( $csr_file ); } else { @names = split( /,/, $names ); } my $challenges = { 'www.ludin.org' => Protocol::ACME::Challenge::SimpleSSH->new( { ssh_host => "bluehost", www_root => "./www" } ), 'cloud.ludin.org' => Protocol::ACME::Challenge::SimpleSSH->new( { ssh_host => "home", www_root => "/opt/local/www/htdocs" } ) }; eval { my $data = Protocol::ACME::_slurp( $account_key_file ); my $acme = Protocol::ACME->new( host => $host, account_key => \$data, debug => 1, mailto => 'sludin@ludin.org' #openssl => "/opt/local/bin/openssl", ); # The first request is for the directory. This provides # all of the top level resources. All urls needed will come # from these resources, the location header, or the link # header(s). $acme->directory(); # Register will call the new-reg resource and create an account associated # with the loaded account key. If that key has already been registered # this method will gracefully and silently handle that. $acme->register(); # In order to use the API you need to accept the TOS. This takes care # of that. No harm is done if this is an existing account and the TOS # have already been accepted. If not done the auth request will return # a 403 $acme->accept_tos(); # authz will start the process of authenticating the identifiers ( domains ) # for each domain you call authx, meet_challenge, and send_challenge_met_message for my $domain ( @names ) { $acme->authz( $domain ); $acme->handle_challenge( $challenges->{$domain} ); $acme->check_challenge(); $acme->cleanup_challenge( $challenges->{$domain} ); } my $buf = Protocol::ACME::_slurp( $csr_file ); my $cert = $acme->sign( $csr_file ); my $fh = IO::File->new( $cert_file, "w" ) || die "Could not open cert file for write: $!"; print $fh $cert; $fh->close(); my $chain = $acme->chain(); # Do something rational with the cert chain, like save it somewhere. }; if ( $@ ) { die $@ if ref $@ ne "Protocol::ACME::Exception"; print "Error occured: Status: $@->{status}, Detail: $@->{detail}, Type: $@->{type}\n"; } else { print "Success\n"; } sub pull_identifiers_from_csr { my $csr_file = shift; my %names; my $fh = IO::File->new( $csr_file ) or die "Could not open CSR: $!"; my $content; while( <$fh> ) { $content .= $_ }; my $req = Convert::X509::Request->new( $content ); my $subject = $req->subject()->{CN}->[0]; $subject =~ s/^.*=//; $names{$subject} = 1; my $san = $req->{extensions}->{'2.5.29.17'}->{value}; if ( $san ) { for ( @$san ) { $names{$_->{dNSName}} = 1; } } return keys %names; } Protocol-ACME-1.01/examples/maketestcerts.sh000644 054744 001130 00000001663 12631700765 020426 0ustar00sludin000000 000000 CERT_DIR=./certs ACCOUNT_KEY=$CERT_DIR/test_account_key.pem CERT_KEY=$CERT_DIR/test_cert_key.pem CSR=$CERT_DIR/test_csr.der SUBJECT="/CN=www.ludin.org" # Generate a new private key for the Let's Encrypt account. For example: openssl genrsa -out $ACCOUNT_KEY 2048 # Generate a new private key for the certificate. For example: openssl genrsa -out $CERT_KEY 2048 # Generate a certificate signing request (CSR). For example (for a single domain cert): # $ openssl req -new -sha256 -key cert_key.pem -outform der -subj "/CN=cloud.ludin.org" > csr.der # # Generating a CSR for a SAN cert ( multiple domains ) is a bit more work. Grab a version # of openssl.cnf and add the following: # # [SAN] # subjectAltName=DNS:domain1.example.com,DNS:domain2.example.com # # and then generate with something like: # openssl req -new -out $CSR -outform der -key $CERT_KEY -config $CERT_DIR/openssl.cnf -reqexts SAN -subj $SUBJECT -sha256 Protocol-ACME-1.01/examples/revoke.pl000644 054744 001130 00000002066 12645350725 017044 0ustar00sludin000000 000000 use strict; use warnings; use Protocol::ACME; use Protocol::ACME::Challenge::Manual; use Protocol::ACME::Challenge::SimpleSSH; use Protocol::ACME::Challenge::LocalFile; use IO::File; use Convert::X509; use Data::Dumper; my $host = "api.letsencrypt.org.edgekey-staging.net"; #my $host = "acme-staging.api.letsencrypt.org"; #my $host = "acme-v01.api.letsencrypt.org"; my $account_key_file = shift; my $cert_file = shift; if ( ! $account_key_file or ! $cert_file ) { die "Usage: perl foo.pl "; } eval { my $acme = Protocol::ACME->new( host => $host, account_key_path => $account_key_file, account_key_format => "PEM", # PEM is the default #ua => $ua ); $acme->directory(); $acme->revoke( $cert_file ); }; if ( $@ ) { die $@ if ref $@ ne "Protocol::ACME::Exception"; print "Error occured: Status: $@->{status}, Detail: $@->{detail}, Type: $@->{type}\n"; } else { print "Success\n"; }