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
|
#! /usr/bin/perl
#
# Written by Oron Peled <oron@actcom.co.il>
# Copyright (C) 2012, Xorcom
# This program is free software; you can redistribute and/or
# modify it under the same terms as Perl itself.
#
#dahdi_sysfs_copy: Short perl script to copy dahdi related sysfs trees
# into a designated directory.
#
# $Id: $
#
use strict;
use warnings;
use File::Path qw(mkpath);
use File::Copy;
use Cwd qw(realpath);
my $destdir = shift || die "Usage: $0 <destdir>\n";
my %symlinks;
my %walk_ups;
my %inode_cash;
# Starting points for recursion
my @toplevels = qw(
/sys/bus/dahdi_devices
/sys/bus/astribanks
/sys/class/dahdi
);
# Loop prevention (by inode number lookup)
sub seen {
my $ino = shift || die;
my $path = shift || die;
if(defined $inode_cash{$ino}) {
#print STDERR "DEBUG($ino): $path\n";
return 1;
}
$inode_cash{$ino}++;
return 0;
}
# Walk up a path and copy readable attributes from any
# directory level.
sub walk_up {
my $path = shift || die;
my $curr = $path;
# Walk up
for (my $curr = $path; $curr; $curr =~ s'/?[^/]+$'') {
my ($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($curr);
next if seen($ino, $curr); # Skip visited directories
# Scan directory
opendir(my $d, $curr) || die "Failed opendir($curr): $!\n";
my @entries = readdir $d;
foreach my $entry (@entries) {
next if $entry =~ /^[.][.]?$/;
my $file = "$curr/$entry";
my ($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($file);
# Copy file
if (-f _ && ($mode & 0004)) { # The '-r _' is buggy
copy($file, "$destdir$file") ||
die "Failed to copy '$file': $!\n";
}
}
closedir $d;
}
}
# Handle a given path (directory,symlink,regular-file)
sub handle_path {
my $path = shift || die;
my ($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($path);
# Save attributes before recursion starts
my $isdir = -d _;
my $islink = -l _;
my $isreadable = $mode & 00004; # The '-r _' was buggy
return if seen($ino, $path); # Loop prevention
my $dest = "$destdir/$path";
if ($isdir) {
mkpath("$dest");
scan_directory($path);
} elsif ($islink) {
# We follow links (the seen() protect us from loops)
my $target = readlink($path) ||
die "Failed readlink($path): $!\n";
my $follow = $target;
if ($target !~ m{^/}) { # fix relative symlinks
my $dir = $path;
$dir =~ s,/[^/]*$,,;
$follow = realpath("$dir/$target");
}
# Save symlink details, so we create them after all
# destination tree (subdirectories, files) is ready
die "Duplicate entry '$dest'\n" if exists $symlinks{$dest};
$symlinks{$dest} = "$target";
# Now follow symlink
handle_path($follow);
$walk_ups{$follow}++;
} elsif ($isreadable) {
copy($path, "$dest") ||
die "Failed to copy '$path': $!\n";
}
}
# Scan a given directory (calling handle_path for recursion)
sub scan_directory {
my $dir = shift || die;
my $entry;
opendir(my $d, $dir) || die "Failed opendir($dir): $!\n";
my @dirs = readdir $d;
foreach my $entry (@dirs) {
next if $entry =~ /^[.][.]?$/;
handle_path("$dir/$entry");
}
closedir $d;
}
# Filter out non-existing toplevels
my @scan = grep { lstat($_) } @toplevels;
# Recurse all trees, creating subdirectories and copying files
foreach my $path (@scan) {
handle_path($path);
}
# Now, that all sub-directories were created, we can
# create the wanted symlinks
for my $dest (keys %symlinks) {
my $link = $symlinks{$dest};
die "Missing link for '$dest'\n" unless defined $link;
unlink $dest if -l $dest;
symlink($link,$dest) ||
die "Failed symlink($link,$dest): $!\n";
}
# Walk up directories that were symlink destinations
# and fill their attributes
foreach my $dir (keys %walk_ups) {
walk_up($dir);
}
|
