summaryrefslogtreecommitdiff
path: root/localwebid-create
blob: 0b38605d14ba2949bc96f15efd92615b8048599d (plain)
  1. #!/usr/bin/perl
  2. # Copyright © 2015 Jonas Smedegaard <dr@jones.dk>
  3. # Description: Create WebID+TLS certificate
  4. #
  5. # This program is free software; you can redistribute it and/or modify
  6. # it under the terms of the GNU General Public License as published by
  7. # the Free Software Foundation; either version 3, or (at your option)
  8. # any later version.
  9. #
  10. # This program is distributed in the hope that it will be useful, but
  11. # WITHOUT ANY WARRANTY; without even the implied warranty of
  12. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  13. # General Public License for more details.
  14. #
  15. # You should have received a copy of the GNU General Public License
  16. # along with this program. If not, see <http://www.gnu.org/licenses/>.
  17. #
  18. # Depends: libweb-id-perl libgetopt-long-descriptive-perl
  19. # libterm-readpassword-perl libpath-tiny-perl
  20. use strict;
  21. use warnings;
  22. use Web::ID::Certificate::Generator;
  23. use Getopt::Long::Descriptive;
  24. use Term::ReadPassword;
  25. use Path::Tiny;
  26. my ($opt, $usage) = describe_options(
  27. 'mywebid-create %o <key+cert.p12>',
  28. [ 'uri|s=s', "URI from where WebID profile will be retrievable",
  29. { required => 1 } ],
  30. [ 'name=s', "subject name on certificate",
  31. { required => 1 } ],
  32. [ 'locality=s', "subject locality on certificate" ],
  33. [ 'region=s', "subject region on certificate" ],
  34. [ 'country=s', "subject country code on certificate (ISO 3166-1)" ],
  35. [],
  36. [ 'password=s', "password for PKCS#12 key+cert bundle" ],
  37. [],
  38. [ 'verbose|v', "print extra stuff" ],
  39. [ 'force|f', "overwrite existing certfile" ],
  40. [ 'noninteractive', "do not prompt for missing password" ],
  41. [ 'help', "print usage message and exit" ],
  42. );
  43. print($usage->text), exit
  44. if $opt->help;
  45. my $certfile = path(shift)
  46. or fail("required certfile argument missing");
  47. ( !$certfile->exists and !$opt->force )
  48. or fail("certfile exists (use --force to overwrite)");
  49. my $pw = $opt->password;
  50. if ( !$pw and !$opt->noninteractive ) {
  51. {
  52. $pw = read_password(
  53. "Enter new WebID certificate password: ", 60, 1 );
  54. if ( defined($pw) and $pw =~ /([^\x20-\x7E])/ ) {
  55. my $bad = unpack "H*", $1;
  56. print "Password may not contain the ";
  57. print "character with hex code $bad.\n";
  58. redo;
  59. }
  60. }
  61. }
  62. fail("password missing")
  63. unless ($pw);
  64. Web::ID::Certificate->generate(
  65. passphrase => $pw,
  66. subject_alt_names => [
  67. Web::ID::SAN::URI->new( value => $opt->uri ),
  68. ],
  69. cert_output => $certfile,
  70. rdf_output => \(my $model),
  71. subject_cn => $opt->name,
  72. subject_locality => $opt->locality,
  73. subject_region => $opt->region,
  74. subject_country => $opt->country,
  75. );
  76. print RDF::Trine::Serializer
  77. -> new('turtle')
  78. -> serialize_model_to_string($model);
  79. sub fail {
  80. my $reason = shift;
  81. print STDERR ("ERROR: $reason\n");
  82. exit 1;
  83. };