-
+ 5FC781391183934125154CE25C932B651B9B49F1A6BED879E124F6F9A2AD7C16543B0763731147634A224832206E94D1FCD3119C074B4D4FC225C4252257032Dv/v.pl(0 . 0)(1 . 969)
5 #!/usr/bin/perl
6
7 # (C) 2014 - 2017 The Bitcoin Foundation. You do not have, nor can you ever
8 # acquire the right to use, copy or distribute this software ; Should you use
9 # this software for any purpose, or copy and distribute it to anyone or in any
10 # manner, you are breaking the laws of whatever soi-disant jurisdiction, and
11 # you promise to continue doing so for the indefinite future. In any case,
12 # please always : read and understand any software ; verify any PGP signatures
13 # that you use - for any purpose.
14
15 use strict;
16
17 my $version = "99994 K ";
18
19 my $tdir = get_homedir() . "/.gnupgtmp";
20
21 my $graph;
22 my %wot = ();
23 my %map = ();
24 my %tmp_map = ();
25 my %banners = ();
26 my %desc_map = ();
27 my %vp_map = ();
28
29 my ($pdir, $sdir, $wdir) = "";
30 my (@pfiles, @sfiles, @wfiles) = ();
31
32 sub get_homedir {
33 my $home = `echo \$HOME`; chomp($home);
34 return $home;
35 }
36
37 sub get_pwd {
38 my $pwd = `pwd`; chomp($pwd);
39 return $pwd;
40 }
41
42 sub set_files {
43 my ($dir) = @_;
44 if(!-d $dir) {
45 my $msg = "$dir directory does not exist.\n" .
46 "See 'init' or 'sync' commands in 'help'.\n";
47 death($msg);
48 }
49 my @a = `ls $dir | sort`;
50 return wash(@a);
51 }
52
53 sub wash { my (@a)=@_; my @b; foreach(@a) {chomp($_); push @b, $_;} return @b; }
54
55 sub init {
56 my ($URL, $pd, $sd) = @_;
57
58 if($URL && $pd && $sd) {
59 if(!-d $pd) { `mkdir -p $pd`; sync_all_vpatches($URL, $pd); }
60 else { print "$pd dir exists! Skipping initial Vpatch sync\n"; }
61 if(!-d $sd) { `mkdir -p $sd`; sync_seals($URL, $sd); }
62 else { print "$sd dir exists! Skipping initial Seal sync\n"; }
63 }
64 }
65
66 sub build_wot {
67 my $uid, my $banner, my $keyid, my $fp;
68 foreach my $pubkey (@wfiles) {
69 my $import = "gpg --homedir $tdir --logger-fd 1 --keyid-format=long " .
70 "--import $wdir/$pubkey 2> /dev/null";
71 my $res = `$import`;
72 $uid = $1 if $pubkey =~ /(.*)\.asc/; chomp($uid);
73 $banner = $1 if $res =~ /\"(.*)\"/; chomp($banner);
74 $keyid = $1 if $res =~ /key (.*)\:/; chomp($keyid);
75 my $res_fp = `gpg --homedir $tdir --logger-fd 1 --fingerprint $keyid`;
76 $fp = $1 if $res_fp =~ /Key fingerprint = (.*)/; $fp =~ s/\s+//g;
77 $wot{$uid} = { fp => $fp, banner => $banner };
78 }
79 }
80
81 sub validate_seals {
82 my $seal_key, my $seal_signatory, my $uid, my $fp, my $patch, my %sig;
83 foreach my $patch (@pfiles) {
84 foreach my $seal (@sfiles) {
85 $seal_key = $1 if $seal =~ /^(.*)\..*\..*$/;
86 $seal_signatory = $1 if $seal =~ /^.*\.(.*)\..*$/;
87 if($patch =~ /^$seal_key$/) {
88 if(exists $wot{$seal_signatory}) {
89 if(not exists $banners{$patch} && $patch ne "") {
90 $banners{$patch} = $patch;
91 %sig = ();
92 }
93 my $verify = "gpg --homedir $tdir --logger-fd 1 --verify $sdir/$seal " .
94 "$pdir/$patch";
95 my @res = `$verify`;
96 foreach my $r (@res) {
97 $fp = $1 if $r =~ /Primary key fingerprint: (.*)/; $fp =~ s/\s+//g;
98 foreach my $uidkey (sort keys %wot) {
99 if($wot{$uidkey}{fp} eq $fp) {
100 $uid = $uidkey;
101 last;
102 }
103 }
104 }
105 my $verified = "";
106 foreach my $r (@res) {
107 if($r =~ /Good signature/ && $uid ne "") {
108 $sig{$wot{$uid}{fp}} = $uid;
109 $banners{$patch} = {%sig};
110 $verified = "true";
111 last;
112 }
113 }
114 if($verified ne "true") {
115 my $border = "-----------------------------------------" .
116 "-----------------------------------------";
117 print "$border\n";
118 print "WARNING: $seal is an INVALID seal for $patch!\n";
119 my $msg = "Check that this user is in your WoT.\n" .
120 "Otherwise remove the invalid seal from your SEALS directory.";
121 print "$msg\n";
122 print "$border\n";
123 death();
124 }
125 $verified = "";
126 }
127 }
128 }
129 }
130 }
131
132 sub build_map {
133 my %vpdata;
134 @pfiles = ();
135 foreach my $vpatch (keys %banners) {
136 push @pfiles, $vpatch;
137 }
138 foreach my $pfile (@pfiles) {
139 $map{$pfile} = $pfile;
140 my @patch = `cat $pdir/$pfile`;
141 my $src_file = "", my $ante_hash = "", my $desc_hash = "";
142 foreach my $p (@patch) {
143 $src_file = $1, $ante_hash = $2 if $p =~ /^--- (.*) (.*)/;
144 $desc_hash = $1 if $p =~ /^\+\+\+ .* (.*)/;
145 if($src_file && $ante_hash && $desc_hash) {
146 death("$pfile is an invalid vpatch!\n") if $ante_hash eq $desc_hash;
147 $vpdata{$src_file} = { a => $ante_hash, b => $desc_hash };
148 $map{$pfile} = {%vpdata};
149 $src_file = "", $ante_hash = "", $desc_hash = "";
150 }
151 }
152 death("Error! $pfile is an invalid vpatch file.\n") if !%vpdata;
153 %vpdata = ();
154 }
155 return %map;
156 }
157
158 sub roots {
159 my @roots = ();
160 my $is_root = "false";
161 foreach my $vpatch (keys %map) {
162 my %ante = antecedents($vpatch);
163 if(!%ante) {
164 foreach my $src_file_name (keys %{$map{$vpatch}}) {
165 if($map{$vpatch}{$src_file_name}->{a} eq "false") {
166 $is_root = "true";
167 next;
168 } else {
169 $is_root = "false";
170 last;
171 }
172 }
173 push @roots, $vpatch if $is_root eq "true";
174 }
175 }
176 return @roots;
177 }
178
179 sub leafs {
180 my @leafs;
181 foreach my $vpatch (keys %map) {
182 my %desc = descendants($vpatch);
183 push @leafs, $vpatch if !%desc;
184 }
185 return @leafs;
186 }
187
188 sub traverse_desc {
189 my (%st) = @_;
190 my %desc;
191 foreach my $k (keys %map) {
192 my @tmp = ();
193 foreach my $src_file_name (keys %{$map{$k}}) {
194 my $src_file = $map{$k}{$src_file_name};
195 foreach my $sf_name (keys %st) {
196 my $sf = $st{$sf_name};
197 if($src_file_name eq $sf_name &&
198 $src_file->{a} eq $sf->{b} &&
199 $src_file->{a} ne "false") {
200 push @tmp, $sf_name;
201 $desc{$k} = [@tmp];
202 }
203 }
204 }
205 }
206 return %desc;
207 }
208
209 sub traverse_ante {
210 my (%st) = @_;
211 my %ante;
212 foreach my $k (keys %map) {
213 my @tmp = ();
214 foreach my $src_file_name (keys %{$map{$k}}) {
215 my $src_file = $map{$k}{$src_file_name};
216 foreach my $sf_name (keys %st) {
217 my $sf = $st{$sf_name};
218 if($src_file_name eq $sf_name &&
219 $src_file->{b} eq $sf->{a} &&
220 $src_file->{b} ne "false") {
221 push @tmp, $sf_name;
222 $ante{$k} = [@tmp];
223 }
224 }
225 }
226 }
227 return %ante;
228 }
229
230 sub search_map {
231 my ($search_key) = @_;
232 if(exists $map{$search_key}) {
233 return %{$map{$search_key}};
234 } else {
235 death("Error! Could not find vpatch \"$search_key\" in $pdir\n");
236 }
237 }
238
239 sub antecedents {
240 my ($vpatch) = @_;
241 return traverse_ante(search_map($vpatch));
242 }
243
244 sub descendants {
245 my ($vpatch) = @_;
246 return traverse_desc(search_map($vpatch));
247 }
248
249 sub get_signatories {
250 my ($vpatch) = @_;
251 my @sigs;
252 foreach my $k (keys %banners) {
253 foreach my $fp (keys %{$banners{$k}}) {
254 my $uid = $banners{$k}{$fp};
255 push @sigs, $uid if $vpatch eq $k;
256 }
257 }
258 push @sigs, "WILD" if !@sigs;
259 return "(" . join(', ', sort @sigs) . ")";
260 }
261
262 sub build_flow {
263 my @flow = ();
264 my @roots = roots();
265 %tmp_map = %map;
266 foreach my $root (@roots) {
267 my %desc = descendants($root);
268 if(%desc) {
269 $desc_map{$root} = [keys %desc];
270 get_all_descendant_nodes(sort keys %desc);
271 verify_ante($root);
272 } else {
273 $desc_map{$root} = [];
274 }
275 }
276 @flow = toposort(%desc_map);
277 %map = scrub_map(@flow);
278 return @flow;
279 }
280
281 sub scrub_map {
282 my (@flow) = @_;
283 foreach my $k (keys %tmp_map) {
284 if(!grep {/$k/} @flow) { delete $tmp_map{$k} if exists $tmp_map{$k}; }
285 }
286 return %tmp_map;
287 }
288
289 sub verify_ante {
290 my (@vpatch) = @_;
291 my %desc = ();
292 foreach my $vp (@vpatch) {
293 %desc = descendants($vp);
294 if(%desc) {
295 foreach my $a (sort keys %desc) {
296 check_ante($a);
297 }
298 }
299 }
300 if(%desc) {
301 verify_ante(sort keys %desc);
302 }
303 }
304
305 sub check_ante {
306 my ($vp) = @_;
307 my @curr_node_edge_hashes = ();
308 my @verified_hashes = ();
309 my %ante = antecedents($vp);
310 foreach my $curr_node_edge (keys %{$tmp_map{$vp}}) {
311 if($tmp_map{$vp}{$curr_node_edge}->{a} ne "false") {
312 push @curr_node_edge_hashes, $tmp_map{$vp}{$curr_node_edge}->{a};
313 }
314 foreach my $ante_node (keys %ante) {
315 foreach my $ante_node_edge (keys %{$tmp_map{$ante_node}}) {
316 next if $curr_node_edge ne $ante_node_edge;
317 if($tmp_map{$vp}{$curr_node_edge}->{a} eq
318 $tmp_map{$ante_node}{$ante_node_edge}->{b}) {
319 push @verified_hashes, $tmp_map{$vp}{$curr_node_edge}->{a};
320 }
321 }
322 }
323 }
324 if(@curr_node_edge_hashes != @verified_hashes) {
325 remove_desc($vp);
326 }
327 }
328
329 sub remove_desc {
330 my (@vp) = @_;
331 my %desc = ();
332 foreach my $v (@vp) {
333 delete $desc_map{$v} if exists $desc_map{$v};
334 delete $tmp_map{$v} if exists $tmp_map{$v};
335 my %desc = descendants($v);
336 next if !%desc;
337 foreach my $d (keys %desc) {
338 foreach my $dkeys (keys %desc_map) {
339 my @tmp = @{$desc_map{$dkeys}};
340 if(@tmp) {
341 my $offset = 0;
342 foreach my $t (@tmp) {
343 if($t eq $d) {
344 splice @tmp, $offset, 1;
345 }
346 $offset++;
347 }
348 $desc_map{$dkeys} = [@tmp];
349 }
350 }
351 }
352 remove_desc(sort keys %desc) if %desc;
353 }
354 }
355
356 sub get_all_descendant_nodes {
357 my (@vpatch) = @_;
358 my %desc = ();
359 foreach my $vp (@vpatch) {
360 %desc = descendants($vp);
361 if(keys %desc) {
362 my @dkeys = keys %desc;
363 $desc_map{$vp} = [@dkeys];
364 get_all_descendant_nodes(sort @dkeys);
365 }
366 if(!%desc) {
367 $desc_map{$vp} = [];
368 }
369 }
370 return %desc_map;
371 }
372
373 sub toposort {
374 my (%unsorted) = @_;
375 my $acyclic = "", my $flag = "f", my @flow = ();
376 while(%unsorted) {
377 $acyclic = "false";
378 foreach my $node (sort keys %unsorted) {
379 my @edges = @{$unsorted{$node}};
380 foreach my $edge (@edges) {
381 $flag = "t" and last if exists $unsorted{$edge};
382 }
383 if($flag ne "t") {
384 $acyclic = "true";
385 delete $unsorted{$node};
386 push @flow, $node;
387 }
388 $flag = "";
389 }
390 if(!$acyclic eq "true") {
391 death("Cyclic Graph!\n");
392 }
393 }
394 return reverse @flow;
395 }
396
397 sub press_vpatches {
398 my ($p, @flow) = @_;
399 my @press = @{$p};
400 my $v = 1 and shift @press if $press[0] =~ /^v$|^verbose$/i;
401 death("HEAD: $press[1] not found in flow\n") if !grep /^$press[1]$/, @flow;
402 `rm -rf $press[0]` if -d $press[0];
403 `mkdir -p $press[0]`;
404 foreach my $vp (@flow) {
405 if($v) {
406 my @out = `patch -F 0 -E --dir $press[0] -p1 < $pdir/$vp 2>&1`;
407 print "$vp\n";
408 foreach my $o (@out) { print " $o"; }
409 } else {
410 `patch -F 0 -E --dir $press[0] -p1 < $pdir/$vp`;
411 }
412 %vp_map = ();
413 verify_pressed($press[0], add_pressed($vp));
414 last if $vp eq $press[1];
415 }
416 }
417
418 sub add_pressed {
419 my ($vpatch) = @_;
420 $vp_map{$vpatch} = $map{$vpatch};
421 return %vp_map;
422 }
423
424 sub get_filepath {
425 my ($fp) = @_;
426 $fp =~ /^[a|b]\/(.*)$/;
427 return $1;
428 }
429
430 sub verify_pressed {
431 my ($press_dir, %vp_map) = @_;
432 foreach my $vp (keys %vp_map) {
433 foreach my $src_file_name (keys %{$vp_map{$vp}}) {
434 my $file_hash = $vp_map{$vp}{$src_file_name}{b};
435 if($file_hash ne "false") {
436 my $fp = $press_dir . "/" . get_filepath($src_file_name);
437 my $hashed = `sha512sum $fp`;
438 $hashed =~ /^(.*) .*$/;
439 my $pressed_hash = $1;
440 if($file_hash ne $pressed_hash) {
441 print " File: $fp\n" .
442 "Expected: $file_hash\n" .
443 " Actual: $pressed_hash\n";
444 death("Pressed file hash did not match expected!\n");
445 }
446 }
447 }
448 }
449 }
450
451 sub sync_seals {
452 my ($URL, $out) = @_;
453 if(!-d $out) { `mkdir -p $out`; }
454 my $wget = "wget -q -r -nd -N --no-parent " .
455 "--reject \"index.html*\" $URL/v/seals/ -P $out";
456 `$wget`;
457 print "Seal sync complete to \"$out\"\n";
458 }
459
460 sub sync_vpatches {
461 my ($URL, $out, @sync) = @_;
462 my $wget = "";
463 if(!-d $out) { `mkdir -p $out`; }
464 foreach my $vpatch (@sync) {
465 $wget = "wget -q -r -nd -N --no-parent " .
466 "--reject \"index.html*\" $URL/v/patches/$vpatch -P $out";
467 `$wget`;
468 print "$vpatch sync complete to \"$out\"\n";
469 }
470 }
471
472 sub sync_all_vpatches {
473 my ($URL, $out) = @_;
474 if(!-d $out) { `mkdir -p $out`; }
475 my $wget = "wget -q -r -nd -N --no-parent " .
476 "--reject \"index.html*\" $URL/v/patches/ -P $out";
477 `$wget`;
478 print "Full vpatch sync complete to \"$out\"\n";
479 }
480
481 sub sync_everything {
482 my ($URL, $pd, $sd) = @_;
483 sync_all_vpatches($URL, $pd);
484 sync_seals($URL, $sd);
485 }
486
487 sub build_desc_full_graph {
488 $graph->set_attributes("graph",
489 {
490 font => "monospace",
491 label => "..::[ The Bitcoin Foundation: Vpatch Graph ]::.."
492 });
493 $graph->set_attributes("node",
494 {
495 linkbase => "http://thebitcoin.foundation/v/patches/",
496 autolink => "name",
497 color => "blue"
498 });
499 my @roots = roots();
500 foreach my $root (@roots) {
501 my $node = $graph->add_node($root);
502 $node->set_attribute("title", "Signed By: " . get_signatories($root));
503 my %desc = descendants($root);
504 my @dkeys = keys %desc;
505 add_desc_edges($root, @dkeys);
506 my @sn = $graph->source_nodes();
507 add_desc_src_files($sn[0]);
508 }
509 }
510
511 sub add_desc_edges {
512 my ($origin, @vpatch) = @_;
513 my %desc = ();
514 foreach my $vp (@vpatch) {
515 %desc = descendants($vp);
516 my $node = $graph->add_node($vp);
517 my $sigs = get_signatories($vp);
518 $node->set_attribute("title", "Signed By: $sigs");
519 $graph->add_edge_once($origin, $vp);
520 if(keys %desc) {
521 my @dkeys = sort keys %desc;
522 add_desc_edges($vp, @dkeys);
523 }
524 }
525 }
526
527 sub add_desc_src_files {
528 my ($node) = @_;
529 if($node != "") {
530 my %desc = descendants($node->name());
531 my @suc = $node->successors();
532 foreach my $s (@suc) {
533 my $name = $s->name();
534 my @edges = $node->edges_to($s);
535 foreach my $e (@edges) {
536 $e->set_attribute("title", "[ " .
537 join('; ', sort @{$desc{$name}}) . " ]");
538 add_desc_src_files($s);
539 }
540 }
541 }
542 }
543
544 sub rank_leafs_gviz {
545 build_desc_full_graph();
546 my $gviz = $graph->as_graphviz();
547 my @leafs = leafs();
548 $gviz =~ s/GRAPH_0/VPATCH_GRAPH/;
549 $gviz =~ s/rankdir=LR/rankdir=BT,ranksep=1.00,nodesep=.50/;
550 $gviz =~ s/}$//;
551 $gviz .= " { rank=same; ";
552 foreach my $l (@leafs) {
553 $gviz .= "\"$l\" ";
554 }
555 $gviz .= "}\n}";
556 return $gviz;
557 }
558
559 sub make_tmpdir {
560 my ($dir) = @_;
561 `mkdir -p $dir && chmod 0700 $dir` if !-d $dir or die "$dir exists! $!";
562 }
563
564 sub death {
565 my ($msg) = @_;
566 remove_tmpdir($tdir);
567 die "$msg";
568 }
569
570 sub remove_tmpdir {
571 my ($dir) = @_;
572 `rm -rf $dir` if -d $dir;
573 }
574
575 sub print_graph {
576 my ($graph, @gv) = @_;
577 if(!@gv) {
578 print "$graph\n";
579 } elsif($#gv eq 1) {
580 open FH, ">$gv[0]"; print FH "$graph\n";
581 close FH;
582 print "Printed Graphviz dot file to $gv[0]\n";
583 my @which = `which dot`; chomp($which[0]);
584 if($which[0] =~ /dot/) {
585 `$which[0] -Tsvg $gv[0] > $gv[1]`;
586 } else {
587 print "`dot` binary not found, check if 'graphviz' is installed\n";
588 }
589 print "Executed `dot` and built svg html output file: $gv[1]\n";
590 } else {
591 open FH, ">$gv[0]"; print FH "$graph\n";
592 close FH;
593 print "Printed Graphviz dot file to $gv[0]\n";
594 }
595 }
596
597 sub get_mirrors {
598 my ($out) = @_;
599 my @mirror_sigs = ();
600 if(!-d $out) { `mkdir -p $out`; }
601 my $wget = "wget -q -r -nd -N --no-parent " .
602 "--reject \"index.html*\" -A 'mirrors.*' " .
603 "http://thebitcoin.foundation/v/ -P $out";
604 `$wget`;
605
606 my @sigs = `ls $out | sort`;
607 @sigs = wash(@sigs);
608 foreach my $sig (@sigs) {
609 my $who = $1 if $sig =~ /.*\..*\.(.*)\..*/;
610 my $verify = "gpg --homedir $tdir --logger-fd 1 --verify $out/$sig " .
611 "$out/mirrors.txt";
612 my @res = `$verify`;
613 foreach my $r (@res) {
614 if($r =~ /Good signature/) {
615 push @mirror_sigs, $who;
616 next;
617 }
618 }
619 }
620 return @mirror_sigs;
621 }
622
623 sub print_mirrors {
624 my ($out) = @_;
625 my @mirror_sigs = get_mirrors($out);
626
627 if(-d $out) {
628 my @mirrors = `cat $out/mirrors.txt`;
629 print "Mirrors signed by (" . join(', ', sort @mirror_sigs) . "):\n";
630 foreach(@mirrors) { chomp($_); print "$_\n"; }
631 }
632 }
633
634 sub print_roots {
635 my @r = roots();
636 foreach(@r) {
637 print "Root: $_ " . get_signatories($_) . "\n";
638 }
639 }
640
641 sub print_leafs {
642 my @l = leafs();
643 foreach(@l) {
644 print "Leaf: $_ " . get_signatories($_) . "\n";
645 }
646 }
647
648 sub print_wot {
649 my ($finger) = @_;
650 if(%wot) {
651 foreach my $uid (sort keys %wot) {
652 if(!$finger) {
653 print "$uid:$wot{$uid}{fp}:$wot{$uid}{banner}\n";
654 } else {
655 print "$uid-" . substr($wot{$uid}{fp}, -16) .
656 ":$wot{$uid}{fp}:$wot{$uid}{banner}\n";
657 }
658 }
659 }
660 }
661
662 sub print_antecedents {
663 my ($vpatch) = @_;
664 my %ante = antecedents($vpatch);
665 my $sigs;
666 foreach my $a (sort keys %ante) {
667 $sigs = get_signatories($a);
668 print "Antecedent: $a $sigs [ " . join('; ', sort @{$ante{$a}}) . " ]\n";
669 }
670 }
671
672 sub print_descendants {
673 my ($vpatch) = @_;
674 my %desc = descendants($vpatch);
675 my $sigs;
676 foreach my $d (sort keys %desc) {
677 $sigs = get_signatories($d);
678 print "Descendant: $d $sigs [ " . join('; ', sort @{$desc{$d}}) . " ]\n";
679 }
680 }
681
682 sub print_origin {
683 my ($hash) = @_;
684 my $found = "f";
685 foreach my $k (keys %map) {
686 foreach my $sf (keys %{$map{$k}}) {
687 if($map{$k}{$sf}{b} eq $hash) {
688 $found = "t";
689 print "Origin: $k " . get_signatories($k) . "\n";
690 }
691 }
692 }
693 print "No Origin Found by Hash: $hash\n" if $found ne "t";
694 }
695
696 sub print_flow {
697 my (@flow) = @_;
698 foreach(@flow) { print "$_ " . get_signatories($_) . "\n"; }
699 }
700
701 sub get_version {
702 my $version_text = << "END_VERSION_TEXT";
703 ################################################################################
704 # ..::[ The Bitcoin Foundation: V ]::.. #
705 # #
706 # Version: $version #
707 # Author: mod6 #
708 # Fingerprint: 0x027A8D7C0FB8A16643720F40721705A8B71EADAF #
709 # #
710 ################################################################################
711 END_VERSION_TEXT
712 return $version_text;
713 }
714
715 sub short_help {
716 my ($flag) = @_;
717 my $short_help = << "END_SHORT_HELP";
718 ################################################################################
719 # ..::[ The Bitcoin Foundation: V ]::.. #
720 # #
721 # Version: $version #
722 # Author: mod6 #
723 # Fingerprint: 0x027A8D7C0FB8A16643720F40721705A8B71EADAF #
724 # #
725 # Usage: v.pl #
726 # (m | mirrors) (<output_dir>) #
727 # (i | init) (mirror_url) [(<pdir> <sdir>)] #
728 # (wd | wotdir) (<wotdir>) #
729 # (pd | patchdir) (<patchdir>) #
730 # (sd | sealdir) (<sealdir>) #
731 # (w | wot) [ finger ] #
732 # (r | roots) #
733 # (l | leafs) #
734 # (f | flow) #
735 # (p | press) (<press_dir> <head>) #
736 # (ss | sync-seals) (<mirror_url> <sdir>) #
737 # (sv | sync-vpatches) (<mirror_url> <pdir> <vpatches>... ) #
738 # (sa | sync-all-vpatches) (<mirror_url> <pdir>) #
739 # (se | sync-everything) (<mirror_url> <pdir> <sdir>) #
740 # (a | ante | antecedents) (<vpatch>) #
741 # (d | desc | descendants) (<vpatch>) #
742 # (o | origin) (<sha512_hash>) #
743 # (g | graph) (<output_dotfile> [<output_svg_html_file>]) #
744 # (v | version) #
745 # (h | ? | help) #
746 # #
747 END_SHORT_HELP
748 my $l = "########################################" .
749 "########################################\n";
750 if($flag) { $short_help .= $l; }
751 return $short_help;
752 }
753
754 sub long_help {
755 print short_help();
756 my $long_help = << "END_LONG_HELP";
757 # Commands: #
758 # m, mirrors (<output_dir>) #
759 # Will attempt to retrieve, cryptographically verify and print entries #
760 # in this list for usage in other commands. Mirrors command my only be #
761 # invoked by itself. [See: sync-seals, sync-vpatches, sync-everything] #
762 # #
763 # i, init (<mirror_url>) [(<pdir> <sdir>)] #
764 # init should be run as the first command executed with V. init only #
765 # requires one option: <mirror_url>. The <pdir> and <sdir> options are #
766 # optional. Use these if you want to override the default Vpatches and #
767 # Seals directories in that exact order. #
768 # #
769 # Defaults: "~/.wot", "patches" (in present working directory) and #
770 # "~/.seals" will be used as defaults. WoTs pubkeys can not be sync'd #
771 # these need to be placed in the WoT directory manually. #
772 # #
773 # Set <mirror_url> to one of the signed URLs in the PGP signed mirrors #
774 # list at: http://thebitcoin.foundation/v/mirrors.txt #
775 # #
776 # wd, wotdir (<wotdir>) #
777 # Given the required option <wotdir>, overrides the default wotdir #
778 # ( .wot in the current working directory ) containing PGP public keys. #
779 # #
780 # pd, patchdir (<patchdir>) #
781 # Given required option of <patchdir>, overrides the default #
782 # patchdir ( ./patches ) containing vpatch files. #
783 # #
784 # sd, sealdir (<sealdir>) #
785 # Given required option of <sealdir>, overrides the default sealdir #
786 # ( .seals in the current working directory ) containing PGP detached #
787 # signatures of vpatch files. #
788 # #
789 # w, wot [ finger ] #
790 # Loads PGP public keys from wotdir and prints the WoT to stdout #
791 # #
792 # r, roots #
793 # Finds the root vpatches (which have no antecedents) and prints them #
794 # to stdout. #
795 # #
796 # l, leafs #
797 # Finds the leaf vpatches (which have no descendants) and prints them #
798 # to stdout. #
799 # #
800 # f, flow #
801 # Prints the topological flow of vpatches based on precedence. #
802 # #
803 # p, press (<press_dir> <head>) #
804 # Given required options <press_dir> output directory and <vpatch> #
805 # press will apply vpatches in topologicial order up through the #
806 # supplied (head) vpatch. Will print patching output if 'verbose' flag #
807 # is supplied immediately after ( p | press ) option. #
808 # See: ( f | flow ) to view the topological ordering. #
809 # #
810 # ss, sync-seals (<mirror_url> <sdir>) #
811 # Given required options of <mirror_url> and output directory <sdir> #
812 # will pull all of the available seal files from the given mirror into #
813 # output directory. #
814 # #
815 # sv, sync-vpatches (<mirror_url> <pdir> <vpatch>... ) #
816 # Given required options of <mirror_url> and output directory <pdir> #
817 # will pull the requested vpatch(s) from the given mirror into output #
818 # directory. #
819 # #
820 # sa, sync-all-vpatches (<mirror_url> <pdir>) #
821 # Given required options of <mirror_url> and output directory <pdir> #
822 # will pull all available vpatches from the given mirror into output #
823 # directory. #
824 # #
825 # se, sync-everything (<mirror_url> <pdir> <sdir>) #
826 # Given required options of <mirror_url>, <pdir>, and <sdir>; #
827 # sync-everything will pull all of the available seals and vpatches #
828 # available at the given mirror. #
829 # #
830 # a, ante, antecedents (<vpatch>) #
831 # Finds the antecedents of a given vpatch and prints the results to #
832 # stdout #
833 # #
834 # d, desc, descendants (<vpatch>) #
835 # Finds the descendants of a given vpatch and prints the results to #
836 # stdout #
837 # #
838 # o, origin (<sha512_hash>) #
839 # Returns the vpatch and signatories where the given hash originated in #
840 # the source tree. #
841 # #
842 # g, graph (<output_dotfile> [<output_svg_html_file>]) #
843 # Builds a complete directed GraphViz graph of all vpatches from a #
844 # topological flow and prints the Dot language output to file. If the #
845 # output_svg_html_file argument is supplied the V will attempt to parse #
846 # the output_dotfile into an html file; Requires having separately #
847 # installed 'graphviz' ahead of time. #
848 # #
849 # v, version #
850 # Prints the version message. #
851 # #
852 # h, ?, help #
853 # Prints this full help message. #
854 # #
855 ################################################################################
856 END_LONG_HELP
857 return $long_help;
858 }
859
860 sub main {
861 my $cmd;
862 if(@ARGV > 0) { $cmd = shift @ARGV; }
863 else { print "Unknown or missing option!\n"; print short_help("t"); return; }
864
865 my $home = get_homedir();
866 my $pwd = get_pwd();
867 $wdir = "$pwd/.wot";
868 $pdir = "$pwd/patches";
869 $sdir = "$pwd/.seals";
870
871 if(($cmd =~ /^m$|^mirrors$/i ||
872 $cmd =~ /^i$|^init$/i ||
873 $cmd =~ /^wd$|^wotdir$/i ||
874 $cmd =~ /^pd$|^patchdir$/i ||
875 $cmd =~ /^sd$|^sealdir$/i ||
876 $cmd =~ /^p$|^press$/i ||
877 $cmd =~ /^ss$|^sync-seals$/i ||
878 $cmd =~ /^sv$|^sync-vpatches$/i ||
879 $cmd =~ /^sa$|^sync-all-vpatches$/i ||
880 $cmd =~ /^sa$|^sync-all-vpatches$/i ||
881 $cmd =~ /^se$|^sync-everything$/i ||
882 $cmd =~ /^a$|^ante$|^antecedents$/i ||
883 $cmd =~ /^d$|^desc$|^descendants$/i ||
884 $cmd =~ /^o$|^origin$/i ||
885 $cmd =~ /^g$|^graph$/i) && !@ARGV) {
886 print "Option \"$cmd\" requires arguments!\n";
887 print short_help("t"); return;
888 }
889
890 my @tmp = ();
891 while(@ARGV > 0) {
892 if($ARGV[0] =~ /^wd$|^wotdir$/) {
893 shift @ARGV; $wdir = shift @ARGV; next;
894 } elsif($ARGV[0] =~ /^pd$|^patchdir$/) {
895 shift @ARGV; $pdir = shift @ARGV; next;
896 } elsif($ARGV[0] =~ /^sd$|^sealdir$/) {
897 shift @ARGV; $sdir = shift @ARGV; next;
898 } else {
899 push @tmp, shift @ARGV;
900 }
901 }
902 @ARGV = @tmp;
903
904 @wfiles = set_files($wdir);
905 build_wot();
906
907 if($cmd =~ /^h$|^help$|^\?$/) { print long_help(); return; }
908 if($cmd =~ /^i$|^init$/) {
909 if(@ARGV == 1) {
910 init(@ARGV, $pdir, $sdir); return;
911 } elsif(@ARGV == 3) {
912 $sdir = pop @ARGV; $pdir = pop @ARGV;
913 init(@ARGV, $pdir, $sdir); return;
914 } else {
915 print "Incorrect number of arguments passed to init!\n";
916 print short_help("t"); return;
917 }
918 }
919
920 if($cmd =~ /^m$|^mirrors$/) { print_mirrors(@ARGV); return; }
921 if($cmd =~ /^w$|^wot$/) { print_wot(@ARGV); return; }
922 if($cmd =~ /^v$|^version$/) { print get_version(); return; }
923
924 @pfiles = set_files($pdir);
925 @sfiles = set_files($sdir);
926
927 validate_seals();
928 build_map();
929 my @flow = build_flow();
930
931 if ($cmd =~ /^r$|^roots$/) { print_roots(); }
932 elsif($cmd =~ /^l$|^leafs$/) { print_leafs(); }
933 elsif($cmd =~ /^f$|^flow$/) { print_flow(@flow); }
934 elsif($cmd =~ /^p$|^press$/) {
935 if(@ARGV < 2) {
936 print "$cmd requires two arguments: (<press_dir> <head>)\n\n";
937 print short_help("t"); }
938 else { press_vpatches(\@ARGV, @flow); } }
939 elsif($cmd =~ /^ss$|^sync-seals$/) {
940 if(@ARGV < 2) {
941 print "$cmd requires two arguments: (<mirror_url> <sdir>)\n\n";
942 print short_help("t"); }
943 else { sync_seals(@ARGV); } }
944 elsif($cmd =~ /^sv$|^sync-vpatches$/) {
945 if(@ARGV < 3) {
946 print "$cmd requires three arguments: " .
947 "(<mirror_url> <pdir> <vpatch>... )\n\n"; print short_help("t"); }
948 else { sync_vpatches(@ARGV); } }
949 elsif($cmd =~ /^sa$|^sync-all-vpatches$/) {
950 if(@ARGV < 2) {
951 print "$cmd requires two arguments: " .
952 "(<mirror_url> <pdir>)\n\n"; print short_help("t"); }
953 else { sync_all_vpatches(@ARGV); } }
954 elsif($cmd =~ /^se$|^sync-everything$/) {
955 if(@ARGV < 3) {
956 print "$cmd requires three arguments: " .
957 "(<mirror_url> <pdir> <sdir>)\n\n"; print short_help("t"); }
958 else { sync_everything(@ARGV); } }
959 elsif($cmd =~ /^a$|^ante$|^antecedents$/) { print_antecedents(@ARGV); }
960 elsif($cmd =~ /^d$|^desc$|^descendants$/) { print_descendants(@ARGV); }
961 elsif($cmd =~ /^o$|^origin$/) { print_origin(@ARGV); }
962 elsif($cmd =~ /^g$|^graph$/) {
963 my $mod = "Graph::Easy";
964 (my $req = $mod . ".pm") =~ s{::}{/}g;
965 require $req;
966 $graph = $mod->new();
967 print_graph(rank_leafs_gviz(), @ARGV); }
968 else { print "Unknown option: \"$cmd\"\n"; print short_help("t"); }
969 }
970
971 make_tmpdir($tdir);
972 main();
973 remove_tmpdir($tdir);