-
Notifications
You must be signed in to change notification settings - Fork 0
/
ecp.pl
1464 lines (1289 loc) · 55.1 KB
/
ecp.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
#!/usr/bin/env perl
#########################################################################
# #
# Script : ecp.pl #
# Authors : Terry Fleury <[email protected]> #
# Create Date : July 06, 2011 #
# Last Update : November 26, 2019 #
# #
# This PERL script allows a user to get an end-user X.509 certificate #
# or PKCS12 credential from the CILogon Service. It can also get the #
# contents of any ECP-enabled Service Provider (SP). The script can be #
# used as an example of how a SAML ECP client works. #
# #
# Studying this script is not an acceptable replacement for reading #
# the specification of the ECP profile [ECP] available at: #
# http://wiki.oasis-open.org/security/SAML2EnhancedClientProfile #
# #
# This script assumes that the server hosting the IdP has been #
# configured to require a type of Basic Auth (username and password) #
# for the ECP location, optionally with Duo as 2FA. #
# #
#########################################################################
# #
# NOTES ON THE CONSTANTS BELOW: #
# #
# * You must set the OPENSSL_BIN constant below to be the full path #
# of the "openssl" binary on your system. #
# #
# * The ECP_IDPS_URL points to a text file listing ECP-enabled IdPs. #
# This file is maintained by CILogon. If you wish to use your own #
# list of ECP-enabled IdPs, the format of the file is very simple: #
# https://example.com/idp/profile/SAML2/SOAP/ECP Example IdP #
# The first string is the IdP's ECP endpoint. Then a space. The rest #
# of the line is a text description which will appear in the list of #
# ECP-enabled IdPs. Put one entry per line. For a local file, you #
# would set "ECP_IDPS_URL => 'file:///path/to/local/file.txt'". #
# #
# * The DEFAULT_IDP is the pretty-print name of the IdP that will be #
# selected by default. #
# #
# * GET_CERT_URL is the CILogon endpoint for fetching a certificate or #
# PKCS12 credential. #
# #
# * The ECP_MAPFILE is the location on disk of a file that can map #
# PAM_USER names to IDPUSER names. This is used when the "--pam" #
# command line option is specified. The file consists of lines where #
# the first entry is the PAM_USER username, and the rest of the line #
# consists of command line options that should override the default #
# options. For example, to map PAM_USER username of jsmith to #
# the ProtectNetwork IdP username joesmith, add the following line #
# to the ecp-mapfile: #
# jsmith --idpuser joesmith --idpname ProtectNetwork #
# #
#########################################################################
use constant {
OPENSSL_BIN =>'/usr/bin/openssl' , ### CHANGE THIS IF NECESSARY
ECP_IDPS_URL =>'https://cilogon.org/include/ecpidps.txt' ,
DEFAULT_IDP =>'University of Illinois at Urbana-Champaign' ,
GET_CERT_URL =>'https://ecp.cilogon.org/secure/getcert/' ,
ECP_MAPFILE =>'/etc/ecp-mapfile' ,
HEADER_ACCEPT=>'text/html; application/vnd.paos+xml' ,
HEADER_PAOS =>'ver="urn:liberty:paos:2003-08";"urn:oasis:names:tc:SAML:2.0:profiles:SSO:ecp"' ,
};
######################
# BEGIN MAIN PROGRAM #
######################
our $VERSION = "0.030";
$VERSION = eval $VERSION;
use strict;
use Module::Load::Conditional qw(check_install);
use Term::ReadLine;
use Term::UI;
use Getopt::Long qw(GetOptionsFromString :config bundling);
use Pod::Usage;
use LWP;
use if (!check_install(module=>'IO::Socket::SSL')), 'Crypt::SSLeay';
use HTTP::Cookies;
use URI;
use IPC::Open3;
use File::Basename;
use File::Spec;
use File::Temp qw(tempfile);
use Symbol qw(gensym);
# Handle <Ctrl>+C to reset the terminal to non-bold text
$SIG{INT} = \&resetTerm;
# Declare variables for command line options
my %opts = ();
my %idps = ();
my $verbose = 0;
my $quiet = 0;
my $term;
my $reply;
my $idpurl = '';
my $idpname = '';
my $idpuser = '';
my $idppass = '';
my $get = '';
my $geturl = '';
my $getstr = '';
my $genrsa = '';
my $certreq = '';
my $inkey = '';
my $outkey = '';
my $outkeyfh;
my $outkeystdout = 0;
my $keyfile = '';
my $csr = '';
my $passwd = '';
my $tfpass = '';
my $duo = '';
my $lifetime = 0;
my $vo = '';
my $outputfile = '';
my $urltoget = '';
my $xmlstr = '';
my $idpresp = '';
my $relaystate = '';
my $responseConsumerURL = '';
my $assertionConsumerServiceURL = '';
# Scan @ARGV for valid command line options
%opts = getCmdLineOpts();
# If the user asked for help, print it and then exit.
if (exists $opts{help}) {
pod2usage(-verbose=>2) && exit 1;
}
# If the user requested version number, print it and then exit.
if (exists $opts{version}) {
print "ecp.pl version '" . main->VERSION . "'\n";
exit 1;
}
# Check if the user wants to bypass SSL hostname verification
if (exists $opts{skipssl}) {
$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0;
}
# Fetch the list of IdPs to list them now or search them later.
%idps = fetchIdps();
if (!keys %idps) { # MAJOR ERROR! No ECP IdPs fetched!
warn "Error: Unable to fetch the list of IdPs from the CILogon server." if
(!$quiet);
exit 1;
}
# If list IdPs, print them out and then exit.
if (exists $opts{listidps}) {
foreach my $key (sort keys %idps) {
print "\e[1m$key\e[0m :\n $idps{$key}\n";
}
exit 1;
}
# If we made it this far, then we want to get something (like a cert).
# If the user entered --pam, then check we are doing pam_exec. Make sure
# that the PAM_TYPE is "auth". Check for the existence of the ECP_MAPFILE.
# If found, check for the PAM_USER username. If found, manipulate @ARGV with
# the configured command line options and call GetOptions again.
if ((exists $opts{pam}) && ($ENV{PAM_TYPE} eq 'auth')) {
my $res = open(MAP,ECP_MAPFILE);
if (defined $res) {
my %ecphash = map { split(/\s+/,$_,2); } <MAP>;
close MAP;
if (defined $ecphash{$ENV{PAM_USER}}) {
%opts = ();
%opts = getCmdLineOpts($ecphash{$ENV{PAM_USER}});
}
}
$opts{proxyfile} = 1;
$opts{certreq} = "create";
if (!exists $opts{lifetime}) {
$opts{lifetime} = 277;
}
if (!exists $opts{idpuser}) {
$opts{idpuser} = $ENV{PAM_USER};
}
if (!exists $opts{idppass}) {
my $passwd = <STDIN>;
chop $passwd;
$opts{idppass} = $passwd;
}
}
# Figure out if we should be verbose or quiet; verbose trumps quiet.
if (exists $opts{quiet}) {
$quiet = 1;
}
if (exists $opts{verbose}) {
$verbose = 1;
$quiet = 0;
}
# If the user entered --duo, validate the requested 2FA method
if (exists $opts{duo}) {
my $duoopt = $opts{duo};
my $duo1 = substr($duoopt,0,1);
if (($duo1 eq 'a') || ($duo1 eq 'p') || ($duo1 eq 'c') || ($duoopt =~ /^\d+$/)) {
$duo = (($duo1 =~ /\d/) ? $duoopt : $duo1);
} else {
warn "Error: Unknown Duo 2FA method '$duoopt'." if (!$quiet);
}
}
# Check if the user entered --idpurl with a valid URL
if (exists $opts{idpurl}) {
$idpurl = trim($opts{idpurl});
if (!isValidURL($idpurl)) {
warn "Error: '$idpurl' does not appear to be a " .
"valid 'https://...' URL." if (!$quiet);
$idpurl = '';
}
}
# If no valid --idpurl given, check for a valid --idpname, use partial match
if ((length($idpurl) == 0) && (exists $opts{idpname})) {
my $found = 0;
$idpname = trim($opts{idpname});
while ((!$found) && ((my $key,my $value) = each %idps)) {
if ($key =~ /$idpname/i) {
$found = 1;
$idpname = $key;
$idpurl = $value;
}
}
if (!$found) {
warn "Error: '$idpname' does not appear to be a valid IdP." if
(!$quiet);
$idpname = '';
}
}
# If neither valid --idpurl nor --idpname given, prompt user
$term = Term::ReadLine->new('readline');
if ((length($idpurl) == 0) && (length($idpname) == 0)) {
my @idpnames = sort keys %idps;
# Find the array position of the default IdP
my %idpidx;
@idpidx{@idpnames} = (0..$#idpnames);
my $defidp = $idpidx{ DEFAULT_IDP.'' };
push(@idpnames,'Specify the ECP endpoint URL of another ECP-enabled IdP');
$reply = $term->get_reply(
prompt => 'Choose',
print_me => 'Select an Identity Provider (IdP):',
choices => \@idpnames,
default => $idpnames[$defidp]
);
if ($reply eq 'Specify the ECP endpoint URL of another ECP-enabled IdP') {
$idpurl = '';
while (!isValidURL($idpurl)) {
$idpurl = trim($term->readline('Enter the IdP URL: '));
if (!isValidURL($idpurl)) {
warn "Error: '$idpurl' does not appear to be a " .
"valid 'https://...' URL." if (!$quiet);
}
}
} else {
$idpname = $reply;
$idpurl = $idps{$idpname};
}
}
# Prompt for the IdP username
if (exists $opts{idpuser}) {
$idpuser = trim($opts{idpuser});
}
while (length($idpuser) == 0) {
$idpuser = trim($term->readline(
'Enter a username for the Identity Provider: '));
if (length($idpuser) == 0) {
warn "Error: IdP username cannot be empty." if (!$quiet);
}
}
# Prompt for the IdP password
if (exists $opts{idppass}) {
$idppass = $opts{idppass};
}
if (length($idppass) == 0) {
system('stty','-echo') if ($^O !~ /MSWin/i);
$idppass = $term->readline('Enter a password for the Identity Provider: ');
if ($^O !~ /MSWin/i) {
system('stty','echo');
print "\n";
}
}
# Print out IdP name, url, and username if verbose is on
if ($verbose) {
if (length($idpname) == 0) {
$idpname = 'User Defined';
}
print "Using the following Identity Provider:\n";
print " \e[1m$idpname\e[0m :\n $idpurl\n";
print "Logging in with username '$idpuser'.\n";
}
# If the '--proxyfile' command line option is set, two things happen:
# (1) the Globus proxy filename is used as the $outputfile, and
# (2) the '--get' operation is set to 'cert'.
# Thus, any other '--out' or '--get' command line parameters are ignored.
if (exists $opts{proxyfile}) {
$opts{out} = getProxyFilename();
$opts{get} = 'c';
}
# Next, figure out the 'get' operation: cert, pkcs12, or url
# Check if the user entered a valid --get parameter (only use 1st letter)
if (exists $opts{get}) {
my $getopt = $opts{get};
$get = substr($getopt,0,1);
if (($get ne 'c') && ($get ne 'p') && ($get ne 'u')) {
warn "Error: Unknown operation '$getopt'." if (!$quiet);
$get = '';
}
}
# Either no --get parameter or not one of [c|p|u], so prompt user
if (length($get) == 0) {
my @choices = ('Certificate using a certificate signing request',
'PKCS12 credential',
'URL that you specify');
$reply = $term->get_reply(
prompt => 'Choose',
print_me => 'What do you want to get?',
choices => \@choices,
default => $choices[0]
);
$get = lc substr($reply,0,1);
}
# If user wants to get a specific URL, check for valid command line option,
# or prompt the user for one.
if ($get eq 'u') {
$getstr = 'URL';
if (exists $opts{url}) {
$geturl = trim($opts{url});
if (!isValidURL($geturl)) {
warn "Error: '$geturl' does not appear to be a valid " .
"'https://...' URL." if (!$quiet);
$geturl = '';
}
}
while (!isValidURL($geturl)) {
$geturl = trim($term->readline('Enter the URL to get: '));
if (!isValidURL($geturl)) {
warn "Error: '$geturl' does not appear to be a valid " .
"'https://...' URL." if (!$quiet);
}
}
}
# If user wants a cert using a CSR, prompt for info to get the csr string
if ($get eq 'c') {
$getstr = 'certificate';
# Check to make sure that the openssl binary is available
if (!checkOpenSSL()) {
warn "Error: Unable to execute the OpenSSL command at '" .
OPENSSL_BIN . "'. Aborting." if (!$quiet);
exit 1;
}
# Check if user specified the CSR filename on the command line
my $certreqfile = '';
if (exists $opts{certreq}) {
$certreqfile = trim($opts{certreq});
if ($certreqfile eq 'create') {
$certreqfile = ''; # Create a CSR on-the-fly
}
} else { # Didn't specify certreq, so prompt for it
$reply = $term->get_reply(
prompt => 'Enter filename',
print_me => 'Enter filename containing a certificate ' .
'signing request,' . "\n" .
'or leave blank to create one on-the-fly:',
default => ' ',
allow => \&blankOrReadable
);
$certreqfile = trim($reply);
}
if (length($certreqfile) > 0) { # If valid CSR, read it in
if (-r $certreqfile) {
my $reqcmd = OPENSSL_BIN . " req -verify -noout -in $certreqfile";
my $verify = runCmdGetStderr($reqcmd);
if ($verify =~ /verify OK/i) {
my $res = open(CSR,$certreqfile);
if (defined $res) {
while(<CSR>) {
$csr .= $_;
}
} else {
warn "Error: Unable to read CSR from file " .
"'$certreqfile'." if (!$quiet);
$certreqfile = '';
}
close CSR;
} else {
warn "Error: Unable to verify CSR in '$certreqfile'." if
(!$quiet);
$certreqfile = '';
}
} else {
warn "Error: Unable to read CSR from file '$certreqfile'." if
(!$quiet);
$certreqfile = '';
}
}
# Check if we need to create a CSR on-the-fly
if (length($certreqfile) == 0) {
if (exists $opts{inkey}) { # Read in private key from file
$inkey = trim($opts{inkey});
if (!(-r $inkey)) {
warn "Error: Unable to read private key from file " .
"'$inkey'." if (!$quiet);
$inkey = '';
}
}
if (length($inkey) > 0) { # Read in key from specified file
$keyfile = $inkey;
} else { # No private key to read in, create one instead
if (exists $opts{outkey}) { # Verify can write out to file
$outkey = trim($opts{outkey});
if (!fileWriteable($outkey)) {
warn "Error: Unable to write private key to file " .
"'$outkey'." if (!$quiet);
$outkey = '';
}
}
# No private key output file specified. If '--proxyfile' wasn't
# specified, prompt for outkey filename.
if ((length($outkey) == 0) && (!exists $opts{proxyfile})) {
$reply = $term->get_reply(
prompt => 'Enter filename',
print_me => 'Enter filename for outputting the private key:',
default => 'userkey.pem',
allow => \&fileWriteable
);
$outkey = trim($reply);
}
# If still no outkey filename and '--proxyfile' was specified,
# or if STDOUT was given as the outkey filename, write the
# key to a temp file.
if (((length($outkey) == 0) && (exists $opts{proxyfile})) ||
($outkey =~ /^(stdout|-)$/i)) {
if ($outkey =~ /^(stdout|-)$/i) {
$outkeystdout = 1; # Print key to stdout at the very end
}
($outkeyfh,$outkey) =
tempfile(UNLINK=>1,TMPDIR=>1,SUFFIX=>'.pem');
} else {
open($outkeyfh,">",$outkey);
}
my $genrsacmd = OPENSSL_BIN . ' genrsa 2048';
$genrsa = runCmdGetStdout($genrsacmd);
if (length($genrsa) > 0) {
print $outkeyfh $genrsa;
close $outkeyfh;
chmod 0600, $outkey;
$keyfile = $outkey;
} else {
warn "Error: Unable to create private key in '$outkey'. " .
"Aborting." if (!$quiet);
exit 1;
}
}
my $reqcmd = OPENSSL_BIN . ' req -new -subj "/CN=ignore"' .
" -key $keyfile";
$csr = runCmdGetStdout($reqcmd);
if (length($csr) == 0) {
warn "Error: Unable to create certificate signing request. " .
"Aborting." if (!$quiet);
exit 1;
}
}
print "Using the following certificate signing request (CSR):\n$csr" if
($verbose);
}
# If user wants PKCS12 credential, prompt for password
if ($get eq 'p') {
$getstr = 'PKCS12 credential';
if (exists $opts{password}) {
$passwd = $opts{password};
if (length($passwd) < 12) {
warn "Error: Password must be at least 12 characters long." if
(!$quiet);
$passwd = '';
}
}
if (length($passwd) < 12) {
while (length($passwd) < 12) {
system('stty','-echo') if ($^O !~ /MSWin/i);
$passwd = $term->readline('Enter a password for the PKCS12 credential: ');
if ($^O !~ /MSWin/i) {
system('stty','echo');
print "\n";
}
if (length($passwd) < 12) {
warn "Error: Password must be at least 12 characters long." if
(!$quiet);
}
}
}
}
# If getting a certificate or a credential, get the lifetime,
# and check for VO two-factor passcode command line options
if (($get eq 'c') || ($get eq 'p')) {
my $maxlifetime = (($get eq 'c') ? 277 : 9516);
if (exists $opts{lifetime}) {
$lifetime = 0 + $opts{lifetime}; # Convert string to number
if ($lifetime < 0) { # Check for negative value
$lifetime = 0;
}
}
if ($lifetime == 0) { # If no lifetime, then prompt for it
$reply = $term->get_reply(
prompt => 'Enter lifetime',
print_me => 'Enter an integer value for the ' . $getstr .
' lifetime (in hours):',
default => $maxlifetime,
allow => \&isPositiveInt
);
$lifetime = 0 + $reply;
}
if ($lifetime > $maxlifetime) {
warn "Warning: Maximum lifetime for $getstr is $maxlifetime hours." if
(!$quiet);
$lifetime = $maxlifetime;
}
print("The $getstr lifetime = $lifetime hours.\n") if ($verbose);
# Check if the user specified a "--vo" command line parameter
if (exists $opts{vo}) {
$vo = trim($opts{vo});
print "Using CILogon Virtual Organization '$vo'.\n" if ($verbose);
}
}
# Figure out the URL to get, either for certreq, PKCS12, or geturl
$urltoget = $geturl;
if (($get eq 'c') || ($get eq 'p')) {
$urltoget = GET_CERT_URL;
}
# If user specified an output file for the certificate, PKCS12 credential,
# or URL, make sure that we can write to it. Otherwise, ask where to output
# the result of the query.
if (exists $opts{out}) {
$outputfile = trim($opts{out});
if (!fileWriteable($outputfile)) {
warn "Error: Specified output file '$outputfile' is not writeable." if
(!$quiet);
$outputfile = '';
}
}
if (length($outputfile) == 0) {
my $defaultout = (($get eq 'p') ? 'usercred.p12' : 'STDOUT');
$reply = $term->get_reply(
prompt => 'Enter filename',
print_me => "Where should the $getstr be written?",
default => $defaultout,
allow => \&fileWriteable
);
$outputfile = trim($reply);
}
if ($outputfile =~ /^(stdout|-)$/i) {
$outputfile = ''; # Empty string later means to write to STDOUT
}
#########################################################################
# At this point, we have all of the information from the user we need #
# to do the operation. Now begins the work of communicating with the #
# Service Provider ($urltoget) and the Identity Provider ($idpurl). #
#########################################################################
# Request the target from the SP and include headers indicating ECP.
# The SP should initially respond with a SOAP message.
# Save any cookies from the IdP and/or SP in a cookie_jar.
my $ua = LWP::UserAgent->new();
my $cookie_jar = HTTP::Cookies->new();
$ua->cookie_jar($cookie_jar);
my $headers = HTTP::Headers->new();
$headers->header(Accept => HEADER_ACCEPT ,
PAOS => HEADER_PAOS
);
$ua->default_headers($headers);
print "First 'get' of ECP URL '$urltoget'... " if ($verbose);
my $response = $ua->get($urltoget);
if ($response->is_success) {
$xmlstr = $response->decoded_content;
if ($verbose) {
print "Succeeded!\n";
print "##### BEGIN SP RESPONSE #####\n";
print "$xmlstr \n";
print "##### END SP RESPONSE #####\n";
}
} else {
if ($verbose) {
print "Failed! Error code: " . $response->status_line . "\n";
print "Try \"curl -H '" . HEADER_ACCEPT . "' -H '" . HEADER_PAOS .
"' '$urltoget'\" to see error details.\n";
}
warn "Error: Unable to get ECP URL '$urltoget'" if (!$quiet);
exit 1;
}
# Get <ecp:RelayState> element from the SP's SOAP response
($xmlstr =~ m#(<ecp:RelayState.*</ecp:RelayState>)#i) && ($relaystate = $1);
if (!$relaystate) {
warn "Error: No <ecp:RelayState> block in response from '$urltoget'." if
(!$quiet);
exit 1;
}
# Extract the xmlns:S from the S:Envelope and put in <ecp:RelayState> block
my $xmlns = '';
($xmlstr =~ m#<S:Envelope (xmlns:[^>]*)>#) && ($xmlns = $1);
$relaystate =~ s#(xmlns:ecp=[^ ]*)#$1 $xmlns#;
# Get the responseConsumerURL
($xmlstr=~m#responseConsumerURL=\"([^\"]*)\"#i) && ($responseConsumerURL=$1);
if (!$responseConsumerURL) {
warn "Error: No responseConsumerURL in response from '$urltoget'." if
(!$quiet);
exit 1;
}
# Remove the SOAP Header from the SP's response, use the SOAP Body later
if (!($xmlstr =~ s#<S:Header>.*</S:Header>##i)) {
warn "Error: No SOAP Header in response from '$urltoget'." if (!$quiet);
exit 1;
}
# Attempt to log in to the IdP with basic authorization
$headers = HTTP::Headers->new();
$headers->authorization_basic($idpuser,$idppass);
# If Duo 2FA was specified, pass the method in the header
if (length($duo) > 0) {
my $factor = '';
$factor = 'auto' if ($duo eq 'a');
$factor = 'push' if ($duo eq 'p');
$factor = 'phone' if ($duo eq 'c');
if ($duo =~ /^\d+$/) {
$factor = 'passcode';
$headers->header('X-Shibboleth-Duo-Passcode'=>$duo);
}
$headers->header('X-Shibboleth-Duo-Factor'=>$factor);
}
$ua->default_headers($headers);
print "Logging in to IdP '$idpurl' with \n$xmlstr\n... " if ($verbose);
$response = $ua->post($idpurl,Content_Type=>'text/xml',Content=>$xmlstr);
if ($response->is_success) {
$idpresp = $response->decoded_content;
if ($verbose) {
print "Succeeded!\n";
print "##### BEGIN IDP RESPONSE #####\n";
print "$idpresp\n";
print "##### END IDP RESPONSE #####\n";
}
} else {
print "Failed! Error code: " . $response->status_line . "\n" if ($verbose);
warn "Error: Unable to log in to IdP '$idpurl'" if (!$quiet);
exit 1;
}
# Verify StatusCode is Success
my @statusCodes = ($idpresp =~ m#StatusCode Value=\"([^\"]*)\"#gi);
my $foundsuccess = 0;
foreach my $code (@statusCodes) {
print "StatusCode: $code\n" if ($verbose);
$foundsuccess = 1 if ($code =~ m#Success#i);
}
if (!$foundsuccess) {
warn "Error: '$idpurl' did not respond with successful authentication." if
(!$quiet);
exit 1;
}
# Find the AssertionConsumerServiceURL from the IdP's response
($idpresp=~m#AssertionConsumerServiceURL=\"([^\"]*)\"#i) &&
($assertionConsumerServiceURL=$1);
if (!$assertionConsumerServiceURL) {
warn "Error: No AssertionConsumerServiceURL in response from '$idpurl'." if
(!$quiet);
exit 1;
}
# Make sure responseConsumerURL and assertionConsumerServiceURL are equal.
# If not, send SOAP fault to the SP and exit.
$headers = HTTP::Headers->new();
$ua->default_headers($headers);
if ($responseConsumerURL ne $assertionConsumerServiceURL) {
warn "Error: responseConsumerURL and assertionConsumerService URL " .
"are not equal.\n" .
"responseConsumerURL = '$responseConsumerURL'\n" .
"assertionConsumerServiceURL = '$assertionConsumerServiceURL'\n" .
"Sending SOAP fault to the Service Provider.\n";
my $soapfault = '<S:Envelope xmlns:S="http://schemas.xmlsoap.org/soap/envelope/"><S:Body><S:Fault><faultcode>S:Server</faultcode><faultstring>responseConsumerURL from SP and assertionConsumerServiceURL from IdP do not match</faultstring></S:Fault></S:Body></S:Envelope>';
$response = $ua->post($responseConsumerURL,
Content_Type => 'application/vnd.paos+xml',
Content => $soapfault
);
# No need to check for response since we are quitting anyway.
exit 1;
}
# Take the response from the IdP, but replace the <ecp:Response> SOAP header
# with the <ecp:RelayState> SOAP header found earlier. Then send this new
# message to the SP's assertionConsumerServiceURL.
if (!($idpresp =~ s#(<soap11:Header>).*(</soap11:Header>)#$1$relaystate$2#i)) {
warn "Error: Could not find <ecp:Response> SOAP header in the " .
"IdP response." if (!$quiet);
exit 1;
}
print "Contacting '$assertionConsumerServiceURL' with \n$idpresp\n..." if ($verbose);
$response = $ua->post($assertionConsumerServiceURL,
Content_Type => 'application/vnd.paos+xml',
Content => $idpresp
);
print "Done!\n" if ($verbose);
# No need to check for response. We only want the (shibboleth) cookie.
# Add a random CSRF cookie for the certificate or PKCS12 credential request.
# This random CSRF value must also be posted to the CILogon service (as a
# <form> value) to pass the CILogon Service's CSRF check.
my $cookiejar = $ua->cookie_jar;
my $uri = URI->new($urltoget);
my $randstr = join('',map { ('a'..'z', 0..9)[rand 36] } (1..10));
$cookiejar->set_cookie(1,'CSRF',$randstr,'/',$uri->host,$uri->port,1,1);
print "Cookie Jar:\n" . $cookiejar->as_string . "\n" if ($verbose);
# Final communication with the original $urltoget. Should return a
# certificate, a PKCS12 credential, or the HTML of a particular URL.
print "Finally, attempting to get the $getstr..." if ($verbose);
my $authOK = 0;
my %formvars;
do {
if ($get eq 'u') { # 'Get' the user-defined URL
$response = $ua->get($urltoget);
} else { # Getting a certificate or credential requires 'post' for form vars
$formvars{'CSRF'} = $randstr; # Add CSRF <form> value to match cookie
if (length($vo) > 0) {
$formvars{'cilogon_vo'} = $vo;
}
if (length($tfpass) > 0) {
$formvars{'tfpasscode'} = $tfpass;
}
if ($get eq 'c') {
$formvars{'submit'} = 'certreq';
$formvars{'certreq'} = $csr;
$formvars{'certlifetime'} = $lifetime;
}
if ($get eq 'p') {
$formvars{'submit'} = 'pkcs12';
$formvars{'p12password'} = $passwd;
$formvars{'p12lifetime'} = $lifetime;
}
$response = $ua->post($urltoget,\%formvars);
}
if ($response->is_success) {
$authOK = 1;
print "Success!\n" if ($verbose);
if (length($outputfile) > 0) {
# If a certificate was fetched (not a PKCS12 or other) and
# either (a) the outputfile is the same as keyfile OR (b) the
# user specified the '--proxyfile' command line option, read in
# the keyfile, then output cert followed by contents of keyfile
# so that cert is before key in the resulting file.
my $keystr = '';
if ($get eq 'c') {
if (($outputfile eq $keyfile) || (exists $opts{proxyfile})) {
my $res = open(KEYFILE,$keyfile);
if (defined $res) {
while(<KEYFILE>) {
$keystr .= $_;
}
} else { # This shouldn't happen, but just in case.
warn "Error: Unable to read key from file " .
"'$keyfile'." if (!$quiet);
$keystr = '';
}
close KEYFILE;
}
}
open(OUTFILE,">$outputfile");
print OUTFILE $response->decoded_content;
# If we read in a key file, write it out after the cert.
if (length($keystr) > 0) {
print OUTFILE "\n$keystr";
}
close OUTFILE;
# For Globus proxy file, max permissions is 600
if (exists $opts{proxyfile}) {
chmod 0600, $outputfile;
}
print "Output written to '$outputfile'.\n" if ($verbose);
} else {
print $response->decoded_content . "\n";
}
if ($outkeystdout == 1) {
print $genrsa;
}
} else {
# Check for "401 Unauthorized", which means two-factor is enabled
if ($response->code == 401) {
# Two-factor prompt is in the "realm" field. Must urlDecode it.
my $realm;
my $headerauth = $response->header('WWW-Authenticate');
($headerauth =~ /realm="(.*)"$/) && ($realm = urlDecode($1));
# Prompt for the passcode
$tfpass = '';
print "\n" . $response->message . ".\n" . $realm . "\n";
while (length($tfpass) == 0) {
$tfpass = trim($term->readline());
if (length($tfpass) == 0) {
warn "Error: Passcode cannot be empty." if (!$quiet);
}
}
# Since $authOK is still false, loop to try to get the URL again
} else {
# Some other server error code = failure
if ($verbose) {
print "Failure! Error code: " . $response->status_line . "\n";
if (length($response->decoded_content) > 0) {
print $response->decoded_content . "\n";
}
}
warn "Error: Unable to get the $getstr. Try the --verbose " .
"command line option." if (!$quiet);
exit 1;
}
}
} until ($authOK);
# Made it this far means success!
exit 0;
####################
# END MAIN PROGRAM #
####################
#########################################################################
# Subroutine: getCmdLineOpts() #
# Parameter : (Optional) A string to scan for command line options. #
# Returns : A hash of command line options read from @ARGV (or the #
# passed-in string) using Getopt::Long. #
# This subroutine scans either the @ARGV array or the passed-in string #
# for command line options and returns any found in a hash. This is a #
# function since GetOptions needs to be called more than once in the #
# main program. #
#########################################################################
sub getCmdLineOpts
{
my $cmdline = shift;
my $ret;
my %options;
my @optdesc = ( 'help|h|?',
'verbose|v',
'version|V',
'quiet|q',
'skipssl|s',
'listidps|l',
'idpname|n=s',
'idpurl|e=s',
'idpuser|u=s',
'idppass|p=s',
'get|g=s',
'certreq|c=s',
'lifetime|t=i',
'inkey|i=s',
'outkey|k=s',
'vo|O=s',
'out|o=s',
'password|P=s',
'duo|d=s',
'proxyfile|1',
'pam|m',
'url|U=s' );
if (length($cmdline) > 0) {
$ret = GetOptionsFromString($cmdline,\%options,@optdesc);
} else {
$ret = GetOptions(\%options,@optdesc)
}
if (!$ret) {
pod2usage(-verbose=>1);
exit 1;
}
return %options;
}
#########################################################################
# Subroutine: fetchIdps() #
# Returns : A hash of IdPs in the form $idps{'idpname'} = 'idpurl' #
# This subroutine fetches the list of Identity Providers from the #
# CILogon server, using the ECP_IDPS_URL defined at the top of this #
# file. It returns a hash where the keys are the "pretty print" names #
# of the IdPs, and the values are the actual URLs of the IdPs. #
#########################################################################
sub fetchIdps
{
my %idps = ();
my $content;
my $ua = LWP::UserAgent->new();
my $response = $ua->get(ECP_IDPS_URL);
if ($response->is_success) {
$content = $response->decoded_content;
} else {
warn $response->status_line;
}
if (defined($content)) {
foreach my $line (split("\n",$content)) {
chomp($line);
my($idpurl,$idpname) = split('\s+',$line,2);
$idps{$idpname} = $idpurl;
}
}
return %idps;
}
#########################################################################
# Subroutine: isValudURL($url) #
# Parameter : $url - The URL to test for valid 'https' url. #
# Returns : 1 if passed-in URL is valid https url, 0 otherwise. #
# This subroutine takes in a string representing a URL and tests to see #
# if it is a valid SSL url (i.e. https://..../...). If the URL is #
# valid, 1 is return, otherwise 0 is returned. #
#########################################################################
sub isValidURL
{
my $url = shift;
my $retval = 0;
my $uri = URI->new($url,'https'); # Allow only 'https://'
if ($uri->scheme) {
$retval = 1;
}
return $retval;
}
#########################################################################
# Subroutine: fileWriteable($filename) #
# Parameter : $filename - The name of a file (specified with or without #
# the full path) to test for write-ability. Can also be #
# 'STDOUT' or '-' which imply write to <stdout>. #
# Returns : 1 if passed-in filename is writeable or 'STDOUT'/'-', #
# 0 otherwise. #
# This subroutine takes in a string representing a filename. The #
# filename can be 'STDOUT' or '-', or prefixed with a directory or not #
# (at which point the current working directory is assumed). It checks #
# to see if the file already exists, and if so, is the file writeable. #
# Otherwise, it checks the containing directory to see if a file can be #
# created there. If so, 1 is returned, otherwise 0 is returned. #
#########################################################################
sub fileWriteable
{
my $filename = trim(shift);
my $retval = 0;
if (length($filename) > 0) {
if ($filename =~ /^(stdout|-)$/i) {
$retval = 1;
} elsif (-e $filename) {
if (-w $filename) {
$retval = 1;
}
} else {
my $dirname = dirname($filename);