/
rr
executable file
·200 lines (178 loc) · 6.55 KB
/
rr
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
#!/usr/bin/perl
my $version="0.1.2";
# perl version after the rr C-program from v9@fakehalo.us
# created PJ 20090815 jakobi@acm.org
# last change PJ 20100210
# copyright: (c) 2009 jakobi@acm.org, GPL v3 or later
# archive: http://jakobi.github.com/script-archive-doc/
# TODO:
# - trimming ~/.rr
# - [vlp] ~/.rr cleanup and/or trimming
# - [medium?] just add a size warning for e.g. more than 500 defined aliases
# - [vlp] consider timestamps/usagecounter and time-or-usage-based
# removal of aliases; maybe with a timestamped log of
# alias/alias-expansion to use for the trimming
# (requiring e.g. a shell variable RR_ALIAS_LOG
# to specify the file and activate logging)
# (with a 0 or negative timestamp to protect aliases)
# (but detailed logging is a privacy issue in the first place; so
# weekly auto trim the log on next invocation with e.g. weighted reording
# the alias cache depending on the deleted log section?
# thus something like head -500 of the ordered aliasses would suffice;
# with maybe a split into 2 aliases sets (possibly in the same file):
# important aliases (that must be kept;manually maintained) and automatic
# section that may expire after some time)
# - [low pri] RR_ALIAS_CACHE to allow multiple alias sets other than ~/.rr
# (or a format change)
# - [vlp] proper arg loop, offering options as alternatives/overrides
# to above shell variable ideas...
# - [?] staggered backups for the removed aliases?
use vars;
use strict;
my($Me)=$0; $Me=~s!.*/!!;
my(%rr,@rr,$o_noflock);
sub usage {
print main::STDERR <<EOF;
$Me - retain and recall (filename) aliases
specify, lookup user-specific filename aliases in ~/.rr. The script
can also run arbitrary commands while performing alias expansion
(//key) and postfix-globbing (//key//glob-pattern).
$Me --help -- usage
$Me --list -- dump contents of ~/.rr
# define aliases
$Me --noflock -- do not lock ~/.rr when appending
$Me /etc/ld.so -- remember partial path
$Me /etc/init.d -- remember as init.d/
$Me = startup /etc/init.d -- or as startup
$Me --alias start=up /etc/init.d -- or as start.up (note: '=' -> '.')
# lookup keys and return aliases
$Me init.d -- returns /etc/init.d/
cd "\$($Me init.d)" -- cd /etc/init.d
echo init.d | $Me -- returns /etc/init.d/
# command execution with alias expansion/postfix-globbing
# (safe exec list call w/o shell; list must contain 2 or more elements)
$Me ls -ld //init.d -- ls -l /etc/init.d/
$Me ls -l //ld.so//.conf -- ls -l /etc/ld.so.conf
$Me vi //init.d//S* -- vi /etc/init.d/S* (expansion by perl glob)
Notes:
- the Perl variant isn't 100% compatible to the original C-version
by v9\@fakehalo.us, both wrt usage and esp. wrt storage format.
- storage format of ~/.rr: blank lines, #comments and aliases
(key=replacement_filename)
- the script dies intentionally on lookup errors or when trying to alias
pathological filenames (embedded \\n).
- some characters in the key are automatically replaced by '.'. This
concerns e.g. '=' characters and tabs.
- command execution and //key//glob-pattern: globbing is done within Perl,
but for disambiguation of globbing, // must the key (note that both the
the key as well as the replacement filename may add another '/')
- directory handling and trailing / in the key: directories are automatically
stored with '/' appended. if the user provided key cannot be found, the
script automatically tries to lookup key+'/'.
- not yet implemented: truncation/cleanup of ~/.rr
(duplicates/redefinitions/size/possibly also age of definition?)
EOF
}
sub lookup {
my($key)=@_;
my $file=$rr{$key};
if ((not defined $file or $file!~/\S/) and
($file!~/\S/ and defined $rr{$key."/"} and $rr{$key."/"}=~/\S/)) {
$key.="/"; $file=$rr{$key};
}
die "# $Me: no file for $key" if not defined $file or not $file=~/\S/;
return($key,$file)
}
sub absfile {
my($file)=@_;
$file=~s! ^\./ !$ENV{PWD}!gx;
$file=~s! //+|/./ !/!gx;
$file=~s! /\.$ !/!gx;
$file=~s! /$ !!gx;
$file.="/" if -d $file;
die "# $Me: exiting - illegal filename.\n" if $file=~/\n/;
return $file
}
sub appendalias {
my($key,$file)=@_;
open(FH,">>","$ENV{HOME}/.rr") and do {
if (not $o_noflock) {
flock FH, 2; seek FH, 0, 2; # paranoia: blocking lock + seek to EOF
}
print FH "$key=$file\n";
} and close FH or die;
}
sub key {
my $key=$_[0];
$key=~s! .*/(?=[^/]) !!x;
my $okey=$key;
$key=~s![=\t\n\r\v]!.!g;
warn "# $Me: key changed to $key\n" if $okey ne $key;
return $key;
}
if (open(FH,"<","$ENV{HOME}/.rr")) {
while(<FH>) {
chomp;
if (/\S/ and not /^\s*#/) {
# old file format: /\/([^\/]+\/?)$/ and do{$rr{$1}=$_; push @rr,$_};
# new short=long format:
/([^=]*?)=(.*)$/ and do{$rr{$1}=$2; push @rr,$_};
}
}
close(FH);
}
if ($ARGV[0]=~/^-?-nof?lock/) {
shift;
$o_noflock=1;
}
if ($ARGV[0]=~/^-?-list$/ ) {
print join("\n",@rr,"");
exit 0;
} elsif ($ARGV[0]=~/^-?-help$/) {
print &usage;
exit 1;
} elsif (2==$#ARGV and $ARGV[0]=~/ ^-?-alias$ | ^=$ /x ) {
# for now just always append the new path to the file
my $file=absfile($ARGV[2]);
my $key=key($ARGV[1]);
appendalias($key,$file);
exit;
} elsif (0==$#ARGV and $ARGV[0]=~m!/[^/]!) {
# for now just always append the new path to the file
my $file=absfile($ARGV[0]);
my $key=key($file);
appendalias($key,$file);
exit;
} elsif (0==$#ARGV) {
my($key,$file)=lookup($ARGV[0]);
print "$file\n";
exit 0;
} elsif(-1==$#ARGV) {
my $key=<main::STDIN>; chomp $key;
my($key,$file)=lookup($key);
print "$file\n";
exit 0;
} else {
my @args;
foreach(@ARGV) {
# only one substitution per arg string
if(m! ^//([^/]+?/?)(?://(.*)$)?$ !x ){
my($str,$glob)=($1,$2);
my($key,$file)=lookup($str);
if (not defined $glob or $glob eq "") {
$_=$file;
push @args,$_;
warn "# $Me: «", join("» «", @args), "»", "\n";
} else {
$_=$file.$glob;
my @glob=glob("$_");
push @args, @glob ? @glob : $_;
warn "# $Me: «", join("» «", @args), "»", "\n";
}
} else {
push @args,$_;
}
}
if (@args) { exec @args } else { exit 1 };
exit 20;
}