view release on metacpan or  search on metacpan

lib/App/sslmaker.pm  view on Meta::CPAN

  $asset->spew({binmode => ":raw"}, $template);
  $asset;
}

sub revoke_cert {
  my ($self, $args) = @_;
  my $home = $self->_home($args);

  local $args->{crl} = $args->{crl} || $home->child('crl.pem');

  openssl qw(ca), $args->{passphrase} ? (-passin => $self->_passphrase($args->{passphrase})) : (),
    -revoke => $args->{revoke};

  return $self->make_crl($args);    # TBD, but will be true
}

sub sign_csr {
  my ($self, $args) = @_;
  my $asset = $args->{cert} ? Path::Tiny->new($args->{cert}) : Path::Tiny->tempfile;

  local $UMASK = 0222;              # make files with mode 444

  openssl qw(ca -batch -notext -md sha256),
    -keyfile    => $args->{ca_key},
    -cert       => $args->{ca_cert},
    -passin     => $self->_passphrase($args->{passphrase}),
    -extensions => $args->{extensions} || 'usr_cert',
    -out        => $asset->path,
    -in         => $args->{csr};

  return $asset;
}

sub subject {
  my $self = shift;
  return $self->{subject} // $ENV{SSLMAKER_SUBJECT} // '' unless @_;
  $self->{subject} = $self->_render_subject(@_);
  return $self;
}

sub with_config {
  my ($self, $cb, $args) = @_;
  my $key = join ':', 'config', map { ($_, $args->{$_} // ''); } @CONFIG_TEMPLATE_KEYS;

  local $args->{home} = $self->_home($args);

  {
    local $UMASK = 0177;    # read/write for current user
    $self->{$key} ||= $self->render_to_file('openssl.cnf', $args);
  }

  local $ENV{OPENSSL_CONF} = $self->{$key}->path;
  return $self->$cb($args);
}

sub _cat {
  my $self = shift;
  my $dest = pop;

  open my $DEST, '>', $dest or croak "Couldn't write $dest: $!";
  local @ARGV = @_;
  print $DEST $_ for <>;
  close $DEST or croak "Couldn't close $dest: $!";
  return $dest;
}

sub _d {
  return 0 unless DEBUG;
  my ($self, $msg) = @_;
  print STDERR "$msg\n";
  return 0;
}

sub _home {
  my ($self, $args) = @_;
  return Path::Tiny->new($args->{home})              if exists $args->{home};
  return Path::Tiny->new($args->{ca_key})->parent(2) if $args->{ca_key};
  return Path::Tiny->new($args->{key})->parent(2)    if $args->{key};
  croak '$SSLMAKER_HOME is required';
}

sub _parse_subject {
  my ($self, $val) = @_;
  return $val if ref $val eq 'HASH';

  # /C=US/ST=Texas/L=Dallas/O=Company/OU=Department/CN=example.com/emailAddress=admin@example.com
  # Subject: C = US, ST = Texas, L = Dallas, O = Company, OU = Department, CN = superduper
  my $re = index($val, '/') == 0 ? qr{/([A-Za-z]+)=([^/]*)} : qr{([A-Za-z]+)\s*=\s*([^,]*)};
  my %subject;
  $subject{$1} = $2 while $val =~ /$re/g;
  return \%subject;
}

sub _passphrase {
  my ($self, $phrase) = @_;

  croak 'Parameter "passphrase" is required' unless defined $phrase and length $phrase;
  return croak "SCALAR is not yet supported" if ref $phrase eq 'SCALAR';
  return "file:$phrase";
}

sub _random_passphrase {
  my ($self, $length) = @_;
  my @chr = ('a' .. 'z', 'A' .. 'Z', 0 .. 9);
  join '', map { $chr[rand @chr] } 1 .. $length;
}

sub _read_subject_from_cert {
  my ($self, $cert) = @_;
  my %subject;

  # Subject: C = US, ST = Texas, L = Dallas, O = Company, OU = Department, CN = superduper
  return openssl qw(x509 -noout -text -in), $cert => sub {
    print STDERR $_[1]               if DEBUG == 2 and length $_[1];
    return $self->_parse_subject($1) if $_[1] =~ m!Subject:\s+(.+)!;
  };

  die qq(Could not read subject from "$cert".);
}

sub _render_subject {