1*0f509175SSree Vemuri#!/usr/bin/perl
2*0f509175SSree Vemuri
3*0f509175SSree Vemuri#
4*0f509175SSree Vemuri# CDDL HEADER START
5*0f509175SSree Vemuri#
6*0f509175SSree Vemuri# The contents of this file are subject to the terms of the
7*0f509175SSree Vemuri# Common Development and Distribution License (the "License").
8*0f509175SSree Vemuri# You may not use this file except in compliance with the License.
9*0f509175SSree Vemuri#
10*0f509175SSree Vemuri# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
11*0f509175SSree Vemuri# or http://www.opensolaris.org/os/licensing.
12*0f509175SSree Vemuri# See the License for the specific language governing permissions
13*0f509175SSree Vemuri# and limitations under the License.
14*0f509175SSree Vemuri#
15*0f509175SSree Vemuri# When distributing Covered Code, include this CDDL HEADER in each
16*0f509175SSree Vemuri# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
17*0f509175SSree Vemuri# If applicable, add the following below this CDDL HEADER, with the
18*0f509175SSree Vemuri# fields enclosed by brackets "[]" replaced with your own identifying
19*0f509175SSree Vemuri# information: Portions Copyright [yyyy] [name of copyright owner]
20*0f509175SSree Vemuri#
21*0f509175SSree Vemuri# CDDL HEADER END
22*0f509175SSree Vemuri#
23*0f509175SSree Vemuri
24*0f509175SSree Vemuri#
25*0f509175SSree Vemuri# Copyright 2008 Sun Microsystems, Inc.  All rights reserved.
26*0f509175SSree Vemuri# Use is subject to license terms.
27*0f509175SSree Vemuri#
28*0f509175SSree Vemuri
29*0f509175SSree Vemuriuse Getopt::Std;
30*0f509175SSree Vemuriuse Cwd;
31*0f509175SSree Vemuri
32*0f509175SSree Vemuriuse strict;
33*0f509175SSree Vemuri
34*0f509175SSree Vemuripackage MDesc;
35*0f509175SSree Vemuri
36*0f509175SSree Vemuriuse constant {
37*0f509175SSree Vemuri    MDEND  => 0x45,
38*0f509175SSree Vemuri    MDNODE => 0x4e,
39*0f509175SSree Vemuri    MDARC  => 0x61,
40*0f509175SSree Vemuri    MDDATA => 0x64,
41*0f509175SSree Vemuri    MDSTR  => 0x73,
42*0f509175SSree Vemuri    MDVAL  => 0x76,
43*0f509175SSree Vemuri};
44*0f509175SSree Vemuri
45*0f509175SSree Vemuri
46*0f509175SSree Vemurisub new {
47*0f509175SSree Vemuri    my $class = shift;
48*0f509175SSree Vemuri    my $self = {};
49*0f509175SSree Vemuri    $self->{FILE} = undef;
50*0f509175SSree Vemuri    $self->{MAJOR} = undef;
51*0f509175SSree Vemuri    $self->{MINOR} = undef;
52*0f509175SSree Vemuri    $self->{NODE_SEC_SZ} = undef;
53*0f509175SSree Vemuri    $self->{NAME_SEC_SZ} = undef;
54*0f509175SSree Vemuri    $self->{DATA_SEC_SZ} = undef;
55*0f509175SSree Vemuri    $self->{NODES} = undef;
56*0f509175SSree Vemuri    $self->{NAMES} = undef;
57*0f509175SSree Vemuri    $self->{DATA} = undef;
58*0f509175SSree Vemuri    bless($self, $class);
59*0f509175SSree Vemuri    return $self;
60*0f509175SSree Vemuri}
61*0f509175SSree Vemuri
62*0f509175SSree Vemurisub open {
63*0f509175SSree Vemuri    my $self = shift;
64*0f509175SSree Vemuri    my ($mdhdr, $size);
65*0f509175SSree Vemuri
66*0f509175SSree Vemuri    if (@_) {
67*0f509175SSree Vemuri        $self->{NAME} = shift;
68*0f509175SSree Vemuri    } else {
69*0f509175SSree Vemuri        $self->{NAME} = '/dev/mdesc';
70*0f509175SSree Vemuri    }
71*0f509175SSree Vemuri    return  unless open(MD, "$self->{NAME}");
72*0f509175SSree Vemuri
73*0f509175SSree Vemuri    # Read and parse MD header
74*0f509175SSree Vemuri    unless (read(MD, $mdhdr, 16) == 16) {
75*0f509175SSree Vemuri        close (MD);
76*0f509175SSree Vemuri	return;
77*0f509175SSree Vemuri    }
78*0f509175SSree Vemuri
79*0f509175SSree Vemuri    ($self->{MAJOR}, $self->{MINOR},
80*0f509175SSree Vemuri     $self->{NODE_SEC_SZ},
81*0f509175SSree Vemuri     $self->{NAME_SEC_SZ},
82*0f509175SSree Vemuri     $self->{DATA_SEC_SZ}) = unpack("nnNNN", $mdhdr);
83*0f509175SSree Vemuri
84*0f509175SSree Vemuri    $size = read(MD, $self->{NODES}, $self->{NODE_SEC_SZ});
85*0f509175SSree Vemuri    $size = read(MD, $self->{NAMES}, $self->{NAME_SEC_SZ});
86*0f509175SSree Vemuri    $size = read(MD, $self->{DATA}, $self->{DATA_SEC_SZ});
87*0f509175SSree Vemuri
88*0f509175SSree Vemuri    1;
89*0f509175SSree Vemuri}
90*0f509175SSree Vemuri
91*0f509175SSree Vemuri#
92*0f509175SSree Vemuri# return hash of given node's information
93*0f509175SSree Vemuri#
94*0f509175SSree Vemurisub getnode {
95*0f509175SSree Vemuri    my ($self, $nodeid) = @_;
96*0f509175SSree Vemuri    my ($tag, $name, $namelen, $nameoff, $datalen, $dataoff, %node);
97*0f509175SSree Vemuri
98*0f509175SSree Vemuri    ($tag, $namelen, $nameoff, $datalen, $dataoff) =
99*0f509175SSree Vemuri      unpack("CCx2NNN", substr($self->{NODES}, $nodeid * 16, 16));
100*0f509175SSree Vemuri    $name = substr($self->{NAMES}, $nameoff, $namelen);
101*0f509175SSree Vemuri    %node = (tag => $tag, name => $name, nameid => $nameoff);
102*0f509175SSree Vemuri
103*0f509175SSree Vemuri    if ($tag == MDSTR || $tag == MDDATA) {
104*0f509175SSree Vemuri        $node{'datalen'} = $datalen;
105*0f509175SSree Vemuri	$node{'dataoff'} = $dataoff;
106*0f509175SSree Vemuri    } elsif ($tag == MDVAL) {
107*0f509175SSree Vemuri        $node{'val'} = ($datalen << 32) | $dataoff;
108*0f509175SSree Vemuri    } elsif ($tag == MDARC || $tag == MDNODE) {
109*0f509175SSree Vemuri        $node{'idx'} = ($datalen << 32) | $dataoff;
110*0f509175SSree Vemuri    }
111*0f509175SSree Vemuri
112*0f509175SSree Vemuri    return %node;
113*0f509175SSree Vemuri}
114*0f509175SSree Vemuri
115*0f509175SSree Vemuri
116*0f509175SSree Vemuri#
117*0f509175SSree Vemuri# return hash of given property's information
118*0f509175SSree Vemuri#
119*0f509175SSree Vemurisub getprop {
120*0f509175SSree Vemuri    my ($self, $propid) = @_;
121*0f509175SSree Vemuri    my (%node, $tag, %prop);
122*0f509175SSree Vemuri
123*0f509175SSree Vemuri    %node = $self->getnode($propid);
124*0f509175SSree Vemuri    $tag = $node{'tag'};
125*0f509175SSree Vemuri    %prop = (name => $node{'name'}, tag => $tag);
126*0f509175SSree Vemuri
127*0f509175SSree Vemuri    if ($tag == MDSTR) {
128*0f509175SSree Vemuri        $prop{'string'} =
129*0f509175SSree Vemuri	  substr($self->{DATA}, $node{'dataoff'}, $node{'datalen'} - 1);
130*0f509175SSree Vemuri    } elsif ($tag == MDARC) {
131*0f509175SSree Vemuri	$prop{'arc'} = $node{'idx'};
132*0f509175SSree Vemuri    } elsif ($tag == MDVAL) {
133*0f509175SSree Vemuri	$prop{'val'} = $node{'val'};
134*0f509175SSree Vemuri    } elsif ($tag == MDDATA) {
135*0f509175SSree Vemuri	$prop{'length'} = $node{'datalen'};
136*0f509175SSree Vemuri	$prop{'offset'} = $node{'dataoff'};
137*0f509175SSree Vemuri    } else {
138*0f509175SSree Vemuri	return undef;
139*0f509175SSree Vemuri    }
140*0f509175SSree Vemuri
141*0f509175SSree Vemuri    return %prop;
142*0f509175SSree Vemuri}
143*0f509175SSree Vemuri
144*0f509175SSree Vemuri
145*0f509175SSree Vemuri#
146*0f509175SSree Vemuri# find name table index of given name
147*0f509175SSree Vemuri#
148*0f509175SSree Vemurisub findname {
149*0f509175SSree Vemuri    my ($self, $name) = @_;
150*0f509175SSree Vemuri    my ($idx, $next, $p);
151*0f509175SSree Vemuri
152*0f509175SSree Vemuri    for ($idx = 0; $idx < $self->{NAME_SEC_SZ}; $idx = $next + 1) {
153*0f509175SSree Vemuri        $next = index($self->{NAMES}, "\0", $idx);
154*0f509175SSree Vemuri	$p = substr($self->{NAMES}, $idx, $next - $idx);
155*0f509175SSree Vemuri	return $idx  if ($p eq $name);
156*0f509175SSree Vemuri    }
157*0f509175SSree Vemuri
158*0f509175SSree Vemuri    return -1;
159*0f509175SSree Vemuri}
160*0f509175SSree Vemuri
161*0f509175SSree Vemuri
162*0f509175SSree Vemuri#
163*0f509175SSree Vemuri# find given property in node
164*0f509175SSree Vemuri#
165*0f509175SSree Vemurisub findprop {
166*0f509175SSree Vemuri    my ($self, $nodeid, $propname, $type) = @_;
167*0f509175SSree Vemuri    my (%node, $nameid);
168*0f509175SSree Vemuri
169*0f509175SSree Vemuri    %node = $self->getnode($nodeid);
170*0f509175SSree Vemuri    return -1  if ($node{'tag'} != MDNODE);
171*0f509175SSree Vemuri
172*0f509175SSree Vemuri    $nameid = $self->findname($propname);
173*0f509175SSree Vemuri    return -1  if ($nameid == -1);
174*0f509175SSree Vemuri
175*0f509175SSree Vemuri    do {
176*0f509175SSree Vemuri        $nodeid++;
177*0f509175SSree Vemuri	%node = $self->getnode($nodeid);
178*0f509175SSree Vemuri	if ($node{'tag'} == $type && $node{'nameid'} == $nameid) {
179*0f509175SSree Vemuri	    return $nodeid;
180*0f509175SSree Vemuri	}
181*0f509175SSree Vemuri    } while ($node{'tag'} != MDEND);
182*0f509175SSree Vemuri
183*0f509175SSree Vemuri    return -1;
184*0f509175SSree Vemuri}
185*0f509175SSree Vemuri
186*0f509175SSree Vemuri
187*0f509175SSree Vemuri#
188*0f509175SSree Vemuri# lookup property in node and return its hash
189*0f509175SSree Vemuri#
190*0f509175SSree Vemurisub lookup {
191*0f509175SSree Vemuri    my ($self, $nodeid, $propname, $type) = @_;
192*0f509175SSree Vemuri    my ($propid);
193*0f509175SSree Vemuri
194*0f509175SSree Vemuri    $propid = $self->findprop($nodeid, $propname, $type);
195*0f509175SSree Vemuri    return undef  if ($propid == -1);
196*0f509175SSree Vemuri
197*0f509175SSree Vemuri    return $self->getprop($propid);
198*0f509175SSree Vemuri}
199*0f509175SSree Vemuri
200*0f509175SSree Vemuri
201*0f509175SSree Vemurisub scan_node {
202*0f509175SSree Vemuri    my ($self, $nodeid, $nameid, $arcid, $ret, $seen) = @_;
203*0f509175SSree Vemuri    my (%node);
204*0f509175SSree Vemuri
205*0f509175SSree Vemuri    return  if ($seen->[$nodeid] == 1);
206*0f509175SSree Vemuri    $seen->[$nodeid] = 1;
207*0f509175SSree Vemuri
208*0f509175SSree Vemuri    %node = $self->getnode($nodeid);
209*0f509175SSree Vemuri    return                if ($node{'tag'} != MDNODE);
210*0f509175SSree Vemuri    push(@$ret, $nodeid)  if ($node{'nameid'} == $nameid);
211*0f509175SSree Vemuri
212*0f509175SSree Vemuri    do {
213*0f509175SSree Vemuri	$nodeid++;
214*0f509175SSree Vemuri	%node = $self->getnode($nodeid);
215*0f509175SSree Vemuri	if ($node{'tag'} == MDARC && $node{'nameid'} == $arcid) {
216*0f509175SSree Vemuri	    $self->scan_node($node{'idx'}, $nameid, $arcid, $ret, $seen);
217*0f509175SSree Vemuri	}
218*0f509175SSree Vemuri    } while ($node{'tag'} != MDEND);
219*0f509175SSree Vemuri}
220*0f509175SSree Vemuri
221*0f509175SSree Vemuri
222*0f509175SSree Vemuri#
223*0f509175SSree Vemuri# scan dag from 'start' via 'arcname'
224*0f509175SSree Vemuri# return list of nodes named 'nodename'
225*0f509175SSree Vemuri#
226*0f509175SSree Vemurisub scan {
227*0f509175SSree Vemuri    my ($self, $start, $nodename, $arcname) = @_;
228*0f509175SSree Vemuri    my ($nameid, $arcid, @ret, @seen);
229*0f509175SSree Vemuri
230*0f509175SSree Vemuri    $nameid = $self->findname($nodename);
231*0f509175SSree Vemuri    $arcid = $self->findname($arcname);
232*0f509175SSree Vemuri    $self->scan_node($start, $nameid, $arcid, \@ret, \@seen);
233*0f509175SSree Vemuri    return @ret;
234*0f509175SSree Vemuri}
235*0f509175SSree Vemuri
236*0f509175SSree Vemuri
237*0f509175SSree Vemuri
238*0f509175SSree Vemuripackage main;
239*0f509175SSree Vemuri
240*0f509175SSree Vemuri
241*0f509175SSree Vemuri#
242*0f509175SSree Vemuri# 'find' needs to use globals anyway,
243*0f509175SSree Vemuri# so we might as well use the same ones
244*0f509175SSree Vemuri# everywhere
245*0f509175SSree Vemuri#
246*0f509175SSree Vemuriour ($old, $new);
247*0f509175SSree Vemuriour %opts;
248*0f509175SSree Vemuri
249*0f509175SSree Vemuri
250*0f509175SSree Vemuri#
251*0f509175SSree Vemuri# fix path_to_inst
252*0f509175SSree Vemuri#
253*0f509175SSree Vemurisub fixinst {
254*0f509175SSree Vemuri    use File::Copy;
255*0f509175SSree Vemuri    my ($oldpat, $newpat);
256*0f509175SSree Vemuri    my ($in, $out);
257*0f509175SSree Vemuri
258*0f509175SSree Vemuri    $oldpat = '"' . $old . '/';
259*0f509175SSree Vemuri    $newpat = '"' . $new . '/';
260*0f509175SSree Vemuri
261*0f509175SSree Vemuri    $in = "etc/path_to_inst";
262*0f509175SSree Vemuri    $out = "/tmp/path$$";
263*0f509175SSree Vemuri
264*0f509175SSree Vemuri    open(IN, "<", $in)     or die "can't open $in\n";
265*0f509175SSree Vemuri    open(OUT, ">", $out)   or die "can't open $out\n";
266*0f509175SSree Vemuri
267*0f509175SSree Vemuri    my ($found, $path);
268*0f509175SSree Vemuri    #
269*0f509175SSree Vemuri    # first pass
270*0f509175SSree Vemuri    # see if there are any old paths that need to be re-written
271*0f509175SSree Vemuri    #
272*0f509175SSree Vemuri    $found = 0;
273*0f509175SSree Vemuri    while (<IN>) {
274*0f509175SSree Vemuri        ($path, undef, undef) = split;
275*0f509175SSree Vemuri        if ($path =~ /^$oldpat/) {
276*0f509175SSree Vemuri            $found = 1;
277*0f509175SSree Vemuri	    last;
278*0f509175SSree Vemuri	}
279*0f509175SSree Vemuri    }
280*0f509175SSree Vemuri    # return if no old paths found
281*0f509175SSree Vemuri    if ($found == 0) {
282*0f509175SSree Vemuri        close(IN);
283*0f509175SSree Vemuri	close(OUT);
284*0f509175SSree Vemuri        unlink $out;
285*0f509175SSree Vemuri        return 0;
286*0f509175SSree Vemuri    }
287*0f509175SSree Vemuri
288*0f509175SSree Vemuri    print "replacing $old with $new in /etc/path_to_inst\n";
289*0f509175SSree Vemuri    #
290*0f509175SSree Vemuri    # 2nd pass
291*0f509175SSree Vemuri    # substitute new for old
292*0f509175SSree Vemuri    #
293*0f509175SSree Vemuri    seek(IN, 0, 0);
294*0f509175SSree Vemuri    while (<IN>) {
295*0f509175SSree Vemuri        ($path, undef, undef) = split;
296*0f509175SSree Vemuri        if ($path =~ /^$oldpat/) {
297*0f509175SSree Vemuri            s/$oldpat/$newpat/;
298*0f509175SSree Vemuri	}
299*0f509175SSree Vemuri        print OUT;
300*0f509175SSree Vemuri    }
301*0f509175SSree Vemuri    close(IN);
302*0f509175SSree Vemuri    close(OUT);
303*0f509175SSree Vemuri
304*0f509175SSree Vemuri    if ($opts{v}) {
305*0f509175SSree Vemuri        print "path_to_inst changes:\n";
306*0f509175SSree Vemuri        system("/usr/bin/diff", $in, $out);
307*0f509175SSree Vemuri        print "\n";
308*0f509175SSree Vemuri    }
309*0f509175SSree Vemuri
310*0f509175SSree Vemuri    move $out, $in        or die "can't modify $in\n";
311*0f509175SSree Vemuri
312*0f509175SSree Vemuri    return 1;
313*0f509175SSree Vemuri}
314*0f509175SSree Vemuri
315*0f509175SSree Vemuri
316*0f509175SSree Vemuriour $oldpat;
317*0f509175SSree Vemuri
318*0f509175SSree Vemurisub wanted {
319*0f509175SSree Vemuri    my $targ;
320*0f509175SSree Vemuri
321*0f509175SSree Vemuri    -l or return;
322*0f509175SSree Vemuri    $targ = readlink;
323*0f509175SSree Vemuri    if ($targ =~ /$oldpat/) {
324*0f509175SSree Vemuri        $targ =~ s/$old/$new/;
325*0f509175SSree Vemuri        unlink;
326*0f509175SSree Vemuri	symlink $targ, $_;
327*0f509175SSree Vemuri        print "symlink $_ changed to $targ\n"  if ($opts{v});
328*0f509175SSree Vemuri    }
329*0f509175SSree Vemuri}
330*0f509175SSree Vemuri
331*0f509175SSree Vemuri#
332*0f509175SSree Vemuri# fix symlinks
333*0f509175SSree Vemuri#
334*0f509175SSree Vemurisub fixdev {
335*0f509175SSree Vemuri    use File::Find;
336*0f509175SSree Vemuri    $oldpat = "/devices" . $old;
337*0f509175SSree Vemuri
338*0f509175SSree Vemuri    print "updating /dev symlinks\n";
339*0f509175SSree Vemuri    find \&wanted, "dev";
340*0f509175SSree Vemuri}
341*0f509175SSree Vemuri
342*0f509175SSree Vemuri
343*0f509175SSree Vemuri#
344*0f509175SSree Vemuri# fixup path_to_inst and /dev symlinks
345*0f509175SSree Vemuri#
346*0f509175SSree Vemurisub fixup {
347*0f509175SSree Vemuri    # setup globals
348*0f509175SSree Vemuri    ($old, $new) = @_;
349*0f509175SSree Vemuri
350*0f509175SSree Vemuri    # if fixinst finds no matches, no need to run fixdev
351*0f509175SSree Vemuri    return  if (fixinst == 0);
352*0f509175SSree Vemuri    fixdev;
353*0f509175SSree Vemuri    print "\n"  if ($opts{v});
354*0f509175SSree Vemuri}
355*0f509175SSree Vemuri
356*0f509175SSree Vemuri#
357*0f509175SSree Vemuri# remove caches
358*0f509175SSree Vemuri#
359*0f509175SSree Vemurisub rmcache {
360*0f509175SSree Vemuri    unlink "etc/devices/devid_cache";
361*0f509175SSree Vemuri    unlink "etc/devices/devname_cache";
362*0f509175SSree Vemuri    unlink <etc/devices/mdi_*_cache>;
363*0f509175SSree Vemuri    unlink "etc/devices/retire_store";
364*0f509175SSree Vemuri    unlink "etc/devices/snapshot_cache";
365*0f509175SSree Vemuri    unlink "dev/.devlink_db";
366*0f509175SSree Vemuri}
367*0f509175SSree Vemuri
368*0f509175SSree Vemuri
369*0f509175SSree Vemuri# $< == 0              or die "$0: must be run as root\n";
370*0f509175SSree Vemuri
371*0f509175SSree Vemurigetopts("vR:", \%opts);
372*0f509175SSree Vemuri
373*0f509175SSree Vemuriif ($opts{R}) {
374*0f509175SSree Vemuri    chdir $opts{R}   or die "can't chdir to $opts{R}\n";
375*0f509175SSree Vemuri}
376*0f509175SSree Vemuricwd() ne "/"         or die "can't run on root directory\n";
377*0f509175SSree Vemuri
378*0f509175SSree Vemuriif ($#ARGV == 1) {
379*0f509175SSree Vemuri    #
380*0f509175SSree Vemuri    # manual run (no MD needed)
381*0f509175SSree Vemuri    #
382*0f509175SSree Vemuri    fixup @ARGV;
383*0f509175SSree Vemuri    rmcache;
384*0f509175SSree Vemuri    exit;
385*0f509175SSree Vemuri}
386*0f509175SSree Vemuri
387*0f509175SSree Vemuri
388*0f509175SSree Vemurimy ($md, @nodes, $nodeid, @aliases, $alias);
389*0f509175SSree Vemurimy (%newpath, %roots);
390*0f509175SSree Vemuri
391*0f509175SSree Vemuri#
392*0f509175SSree Vemuri# scan MD for ioaliases
393*0f509175SSree Vemuri#
394*0f509175SSree Vemuri$md = MDesc->new;
395*0f509175SSree Vemuri$md->open;
396*0f509175SSree Vemuri
397*0f509175SSree Vemuri@nodes = $md->scan(0, "ioaliases", "fwd");
398*0f509175SSree Vemuri$#nodes == 0    or die "missing ioaliases node\n";
399*0f509175SSree Vemuri
400*0f509175SSree Vemuri#
401*0f509175SSree Vemuri# foreach ioalias node, replace any 'alias' paths
402*0f509175SSree Vemuri# with the 'current' one
403*0f509175SSree Vemuri#
404*0f509175SSree Vemuri# complicating this is that the alias paths can be
405*0f509175SSree Vemuri# substrings of each other, which can cause false
406*0f509175SSree Vemuri# hits in /etc/path_to_inst, so first gather all
407*0f509175SSree Vemuri# aliases with the same root into a list, then sort
408*0f509175SSree Vemuri# it by length so we always fix the longer alias
409*0f509175SSree Vemuri# paths before the shorter ones
410*0f509175SSree Vemuri#
411*0f509175SSree Vemuri@nodes = $md->scan(@nodes[0], "ioalias", "fwd");
412*0f509175SSree Vemuriforeach $nodeid (@nodes) {
413*0f509175SSree Vemuri    my (%prop, $current);
414*0f509175SSree Vemuri
415*0f509175SSree Vemuri    %prop = $md->lookup($nodeid, "aliases", $md->MDSTR);
416*0f509175SSree Vemuri    @aliases = split(/ /, $prop{'string'});
417*0f509175SSree Vemuri
418*0f509175SSree Vemuri    %prop = $md->lookup($nodeid, "current", $md->MDSTR);
419*0f509175SSree Vemuri    $current = $prop{'string'};
420*0f509175SSree Vemuri
421*0f509175SSree Vemuri    foreach $alias (@aliases) {
422*0f509175SSree Vemuri        next  if ($alias eq $current);
423*0f509175SSree Vemuri
424*0f509175SSree Vemuri        my ($slash, $root);
425*0f509175SSree Vemuri	$newpath{$alias} = $current;
426*0f509175SSree Vemuri	$slash = index($alias, '/', 1);
427*0f509175SSree Vemuri	if ($slash == -1) {
428*0f509175SSree Vemuri	    $root = $alias;
429*0f509175SSree Vemuri	} else {
430*0f509175SSree Vemuri	    $root = substr($alias, 0, $slash);
431*0f509175SSree Vemuri	}
432*0f509175SSree Vemuri	push(@{ $roots{$root} }, $alias);
433*0f509175SSree Vemuri    }
434*0f509175SSree Vemuri}
435*0f509175SSree Vemuri
436*0f509175SSree Vemurimy $aref;
437*0f509175SSree Vemuriforeach $aref (values %roots) {
438*0f509175SSree Vemuri    @aliases = sort { length($b) <=> length($a) } @$aref;
439*0f509175SSree Vemuri    foreach $alias (@aliases) {
440*0f509175SSree Vemuri        fixup $alias, $newpath{$alias};
441*0f509175SSree Vemuri    }
442*0f509175SSree Vemuri}
443*0f509175SSree Vemuri
444*0f509175SSree Vemurirmcache;
445