Crypt-LE

 view release on metacpan or  search on metacpan

lib/Crypt/LE.pm  view on Meta::CPAN

        } else {
            return $self->_status(ERROR, $content);
        }
    } elsif ($status == CREATED) {
        $self->{new_registration} = 1;
        $self->{registration_info} = $content;
        $self->{tos_changed} = 0;
        my $tos_message = '';
        if ($self->{links}->{'terms-of-service'}) {
            $self->{tos_changed} = 1;
            $tos_message = "You need to accept TOS at $self->{links}->{'terms-of-service'}";
        }
        $self->_debug("New key is now registered, reg path: $self->{directory}->{reg}. $tos_message");
    } elsif ($status == BAD_REQUEST and $kid and $mac and $self->_pull_error($content)=~/not awaiting/) {
        # EAB credentials were already associated with the key.
        if ($self->{directory}->{reg}) {
            $self->_debug("EAB credentials already associated. Account URL is: $self->{directory}->{reg}.");
        } else {
            return $self->_status(ERROR, "EAB credentials already associated and no EAB id was provided.");
        }
    } else {
        return $self->_status(ERROR, $content);
    }
    if ($self->{registration_info} and ref $self->{registration_info} eq 'HASH') {
        $self->{registration_id} = $self->{registration_info}->{id};
        if ($self->{registration_info}->{contact} and (ref $self->{registration_info}->{contact} eq 'ARRAY') and @{$self->{registration_info}->{contact}}) {
            $self->{contact_details} = $self->{registration_info}->{contact};
        }
    }
    if (!$self->{registration_id} and $self->{directory}->{reg}=~/\/([^\/]+)$/) {
        $self->{registration_id} = $1;
    }
    $self->_debug("Account ID: $self->{registration_id}") if $self->{registration_id};
    return $self->_status(OK, "Registration success: TOS change status - $self->{tos_changed}, new registration flag - $self->{new_registration}.");
}

=head2 accept_tos()

Accepts Terms of Service set by Let's Encrypt.

Returns: OK | ERROR.

=cut

sub accept_tos {
    my $self = shift;
    return $self->_status(OK, "TOS has NOT been changed, no need to accept again.") unless $self->tos_changed;
    my ($status, $content) = $self->_request($self->{directory}->{'reg'}, { resource => 'reg', agreement => $self->{links}->{'terms-of-service'} });
    return ($status == $self->_compat_response(ACCEPTED)) ? $self->_status(OK, "Accepted TOS.") : $self->_status(ERROR, $content);
}

=head2 update_contacts($array_ref)

Updates contact details for your Let's Encrypt account. Accepts an array reference of contacts.
Non-prefixed contacts will be automatically prefixed with 'mailto:'.

Returns: OK | INVALID_DATA | ERROR.

=cut

sub update_contacts {
    my ($self, $contacts) = @_;
    return $self->_status(INVALID_DATA, "Invalid call parameters.") unless ($contacts and (ref $contacts eq 'ARRAY'));
    my @set = map { /^\w+:/ ? $_ : "mailto:$_" } @{$contacts};
    my ($status, $content) = $self->_request($self->{directory}->{'reg'}, { resource => 'reg', contact => \@set });
    return ($status == $self->_compat_response(ACCEPTED)) ? $self->_status(OK, "Email has been updated.") : $self->_status(ERROR, $content);
}

=head2 request_challenge()

Requests challenges for domains on your CSR. On error you can call failed_domains() method, which returns an array reference to domain names for which
the challenge was not requested successfully.

Returns: OK | ERROR.

=cut

sub request_challenge {
    my $self = shift;
    $self->_status(ERROR, "No domains are set.") unless $self->{domains};
    my ($domains_requested, %domains_failed);
    # For v2.0 API the 'new-authz' is optional. However, authz set is provided via newOrder request (also utilized by request_certificate call).
    # We are keeping the flow compatible with older clients, so if that call has not been specifically made (as it would in le.pl), we do
    # it at the point of requesting the challenge. Note that if certificate is already valid, we will skip most of the challenge-related
    # calls, but will not be returning the cert early to avoid interrupting the established flow.
    if ($self->version() > 1) {
        unless ($self->{authz}) {
            my ($status, $content) = $self->_request($self->{directory}->{'new-cert'}, { resource => 'new-cert' });
            if ($status == CREATED and $content->{'identifiers'} and $content->{'authorizations'}) {
                push @{$self->{authz}}, [ $_, '' ] for @{$content->{'authorizations'}};
                $self->{finalize} = $content->{'finalize'};
            } else {
                unless ($self->{directory}->{'new-authz'}) {
                    return $self->_status(ERROR, "Cannot request challenges - " . $self->_pull_error($content) . "($status).");
                }
                $self->_get_authz();
            }
        }
    } else {
        $self->_get_authz();
    }
    foreach my $authz (@{$self->{authz}}) {
        $self->_debug("Requesting challenge.");
        my ($status, $content) = $self->_request(@{$authz});
        $domains_requested++;
        if ($status == $self->_compat_response(CREATED)) {
            my $valid_challenge = 0;
            return $self->_status(ERROR, "Missing identifier in the authz response.") unless ($content->{identifier} and $content->{identifier}->{value});
            my $domain = $content->{identifier}->{value};
            $domain = "*.$domain" if $content->{wildcard};
            foreach my $challenge (@{$content->{challenges}}) {
                unless ($challenge and (ref $challenge eq 'HASH') and $challenge->{type} and
                       ($challenge->{url} or $challenge->{uri}) and
                       ($challenge->{status} or $content->{status})) {
                    $self->_debug("Challenge for domain $domain does not contain required fields.");
                    next;
                }
                my $type = (split '-', delete $challenge->{type})[0];
                unless ($challenge->{token} and $challenge->{token}=~$url_safe) {
                    $self->_debug("Challenge ($type) for domain $domain is missing a valid token.");
                    next;



( run in 0.589 second using v1.01-cache-2.11-cpan-39bf76dae61 )