- #!/usr/bin/perl
- # Copyright © 2015 Jonas Smedegaard <dr@jones.dk>
- # Description: Create WebID+TLS certificate
- #
- # This program is free software; you can redistribute it and/or modify
- # it under the terms of the GNU General Public License as published by
- # the Free Software Foundation; either version 3, or (at your option)
- # any later version.
- #
- # This program is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of
- # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- # General Public License for more details.
- #
- # You should have received a copy of the GNU General Public License
- # along with this program. If not, see <http://www.gnu.org/licenses/>.
- #
- # Depends: libweb-id-perl libgetopt-long-descriptive-perl
- # libterm-readpassword-perl libpath-tiny-perl
- use strict;
- use warnings;
- use Web::ID::Certificate::Generator;
- use Getopt::Long::Descriptive;
- use Term::ReadPassword;
- use Path::Tiny;
- my ($opt, $usage) = describe_options(
- 'mywebid-create %o <key+cert.p12>',
- [ 'uri|s=s', "URI from where WebID profile will be retrievable",
- { required => 1 } ],
- [ 'name=s', "subject name on certificate",
- { required => 1 } ],
- [ 'locality=s', "subject locality on certificate" ],
- [ 'region=s', "subject region on certificate" ],
- [ 'country=s', "subject country code on certificate (ISO 3166-1)" ],
- [],
- [ 'password=s', "password for PKCS#12 key+cert bundle" ],
- [],
- [ 'verbose|v', "print extra stuff" ],
- [ 'force|f', "overwrite existing certfile" ],
- [ 'noninteractive', "do not prompt for missing password" ],
- [ 'help', "print usage message and exit" ],
- );
- print($usage->text), exit
- if $opt->help;
- my $certfile = path(shift)
- or fail("required certfile argument missing");
- ( !$certfile->exists and !$opt->force )
- or fail("certfile exists (use --force to overwrite)");
- my $pw = $opt->password;
- if ( !$pw and !$opt->noninteractive ) {
- {
- $pw = read_password(
- "Enter new WebID certificate password: ", 60, 1 );
- if ( defined($pw) and $pw =~ /([^\x20-\x7E])/ ) {
- my $bad = unpack "H*", $1;
- print "Password may not contain the ";
- print "character with hex code $bad.\n";
- redo;
- }
- }
- }
- fail("password missing")
- unless ($pw);
- Web::ID::Certificate->generate(
- passphrase => $pw,
- subject_alt_names => [
- Web::ID::SAN::URI->new( value => $opt->uri ),
- ],
- cert_output => $certfile,
- rdf_output => \(my $model),
- subject_cn => $opt->name,
- subject_locality => $opt->locality,
- subject_region => $opt->region,
- subject_country => $opt->country,
- );
- print RDF::Trine::Serializer
- -> new('turtle')
- -> serialize_model_to_string($model);
- sub fail {
- my $reason = shift;
- print STDERR ("ERROR: $reason\n");
- exit 1;
- };
|