1 #!/usr/bin/perl
2 
3 use strict;
4 use warnings;
5 
6 use IPC::Open2;
7 use Getopt::Std;
8 use File::Basename;
9 use File::Path 'make_path';
10 
11 our ($opt_g, $opt_d, $opt_r);
12 my $gpg;
13 
14 # usage: print usage information to stderr and exit with error.
15 sub usage {
16 	my $cmd = basename $0;
17 	die
18 "usage: $cmd [-g command] [-d dir] add [-m] name\n" .
19 "       $cmd [-d dir] rm name ...\n" .
20 "       $cmd [-g command] [-d dir] show name\n" .
21 "       $cmd [-d dir] mv from to\n" .
22 "       $cmd [-d dir] ls\n";
23 }
24 
25 # getrecipient: return string to be used with gpg's -r option.
26 #
27 # Past versions of gpm (written in shell) required explicit recipient, set by
28 # option -r, or the GPM_RECIPIENT environment variable. This is completely
29 # unnecessary now, due to GPM_GPG and -g, but legacy syntax is still maintained.
30 sub getrecipient {
31 	my $r = $opt_r;
32 	defined $r or $r = $ENV{GPM_RECIPIENT};
33 	return $r;
34 }
35 
36 # ckpath $path
37 #
38 # Return 1 if $path doesn't start with /, or contain .. files, and 0 otherwise.
39 sub ckpath {
40 	my ($p) = @_;
41 	return $p !~ m,^/, && $p ne ".." && $p !~ m,^\.\./, && $p !~ m,/\.\./,
42 	    && $p !~ m,/\.\.$,;
43 }
44 
45 # cklegacy $f
46 #
47 # Returns the correct path for $f (with or without the .gpg suffix), or dies
48 # if no such file exists.
49 sub cklegacy {
50 	my ($f) = @_;
51 	if (!-f $f) {
52 		my $f2 = $f . ".gpg";
53 		-f $f2 or die "neither $f, nor $f2 exist as regular files\n";
54 		return $f2;
55 	}
56 	return $f;
57 }
58 
59 # prunetree $d: remove empty directories, starting from $d, and going up.
60 sub prunetree {
61 	for (my ($d) = @_; $d ne "."; $d = dirname $d) {
62 		rmdir $d or last;
63 	}
64 }
65 
66 # add
67 #
68 # Encrypt the secret from stdin, and store the ciphertext in file specified
69 # on the command line.
70 sub add {
71 	our $opt_m;
72 	my $r = getrecipient;
73 	my ($cmd, $sec);
74 
75 	$cmd .= "$gpg -e";
76 	$cmd .= " -r $r" if defined $r;
77 
78 	getopts('m') or usage;
79 	$#ARGV >= 0 or usage;
80 
81 	my $outfile = $ARGV[0];
82 	ckpath $outfile or die "bad path: $outfile\n";
83 
84 	-e $outfile and die "$outfile already exists\n";
85 
86 	if (-t STDIN && !$opt_m) {
87 		system "stty -echo";
88 
89 		print "Secret:";
90 		$sec = <STDIN>;
91 		print "\n";
92 		print "Repeat:";
93 		my $sec2 = <STDIN>;
94 		print "\n";
95 		die "Sorry\n" if $sec ne $sec2;
96 
97 		system "stty echo";
98 	} else { while (<STDIN>) { $sec .= $_; } }
99 
100 	my $pid = open2(my $reader, my $writer, $cmd);
101 	print $writer $sec;
102 	close($writer);
103 	my $out;
104 	while (<$reader>) { $out .= $_; }
105 	waitpid $pid, 0;
106 	$? == 0 or exit 1;
107 
108 	my $d = dirname $outfile;
109 	make_path($d, {mode => 0700});
110 	umask 0377;
111 	unless (open FH, ">$outfile") {
112 		prunetree($d);
113 		die "couldn't open $outfile for writing: $!\n";
114 	}
115 	unless (print FH $out) {
116 		prunetree($d);
117 		die "couldn't write to $outfile: $!\n";
118 	}
119 }
120 
121 # ls
122 #
123 # Produce a listing of files in the gpm directory, using the GPM_LSCMD
124 # environment variable if defined.
125 sub ls {
126 	my $cmd = $ENV{GPM_LSCMD};
127 	unless (defined $cmd) {
128 		opendir my $dh, "." or die "couldn't open directory .: $!\n";
129 		while (readdir $dh) {
130 			if ($_ ne "." && $_ ne ".." && -d $_) {
131 				$cmd = "find . -type f | sed 's,^\./,,'";
132 				last;
133 			}
134 		}
135 		$cmd = "ls" unless defined $cmd;
136 	}
137 	system($cmd);
138 	$? == 0 or exit 1;
139 }
140 
141 # mv: safely rename $ARGV[0] to $ARGV[1].
142 sub mv {
143 	$#ARGV >= 1 || usage;
144 	my ($from, $to) = @ARGV;
145 	ckpath $from or die "bad path $from\n";
146 	ckpath $to or die "bad path $to\n";
147 	-e $to and die "$to already existst\n";
148 	$from = cklegacy $from;
149 
150 	make_path(dirname $to, {mode => 0700});
151 	rename $from, $to;
152 	prunetree(dirname $from);
153 }
154 
155 # rm: unlink arguments, asking each time.
156 sub rm {
157 	$#ARGV >= 0 || usage;
158 	for (@ARGV) {
159 		my $f = $_;
160 		unless (ckpath $f) {
161 			print STDERR "bad path $f\n";
162 			next;
163 		}
164 		$f = cklegacy $f;
165 		print "Really remove $f? ";
166 		<STDIN> =~ m/^[Yy]/ and unlink $f;
167 		prunetree(dirname $f);
168 	}
169 }
170 
171 # show: decrypt file, and print plaintext to stdout.
172 sub show {
173 	$#ARGV >= 0 or usage;
174 	my $file = $ARGV[0];
175 	ckpath $file or die "bad path $file\n";
176 	$file = cklegacy $file;
177 
178 	system("$gpg -d $file");
179 	$? == 0 or exit 1;
180 }
181 
182 getopts('g:d:r') or usage;
183 
184 $#ARGV >= 0 or usage;
185 my $cmd = $ARGV[0];
186 shift @ARGV;
187 
188 $gpg = $opt_g;
189 $gpg = $ENV{GPM_GPG} unless defined $gpg;
190 $gpg = "gpg" unless defined $gpg;
191 
192 my $gpmd = $opt_d;
193 defined $gpmd or $gpmd = $ENV{GPM_DIR};
194 unless (defined $gpmd) {
195 	if (defined $ENV{XDG_DATA_HOME}) {
196 		$gpmd = $ENV{XDG_DATA_HOME} . "/gpm";
197 	} elsif (defined $ENV{HOME}) {
198 		$gpmd = $ENV{HOME} . "/.gpm";
199 	} else {
200 		die "couldn't determine the gpm directory\n";
201 	}
202 }
203 
204 make_path($gpmd, {mode => 0700});
205 chdir $gpmd or die "couldn't change directory to $gpmd: $!\n";
206 
207 for ($cmd) {
208 if (/^a/) { add; last; }
209 if (/^l/) { ls; last; }
210 if (/^m/) { mv; last; }
211 if (/^r/) { rm; last; }
212 if (/^s/) { show; last; }
213 	usage;
214 }