Initial WebID creation script.

1 files changed, 92 insertions, 0 deletions

diff --git a/localwebid-create b/localwebid-create
new file mode 100755
index 0000000..0b38605
--- /dev/null
+++ b/localwebid-create
@@ -0,0 +1,92 @@
+#!/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;
+};