Reported by Trent Creekmore
[dahdi/tools.git] / build_tools / dahdi_sysfs_copy
1 #! /usr/bin/perl
2 #
3 # Written by Oron Peled <oron@actcom.co.il>
4 # Copyright (C) 2012, Xorcom
5 # This program is free software; you can redistribute and/or
6 # modify it under the same terms as Perl itself.
7 #
8 #dahdi_sysfs_copy: Short perl script to copy dahdi related sysfs trees
9 #                  into a designated directory.
10 #
11 # $Id: $
12 #
13 use strict;
14 use warnings;
15
16 use File::Path qw(mkpath);
17 use File::Copy;
18 use Cwd qw(realpath);
19
20 my $destdir = shift || die "Usage: $0 <destdir>\n";
21
22 my %symlinks;
23 my %walk_ups;
24 my %inode_cash;
25
26 # Starting points for recursion
27 my @toplevels = qw(
28         /sys/bus/dahdi_devices
29         /sys/bus/astribanks
30         /sys/class/dahdi
31         );
32
33 # Loop prevention (by inode number lookup)
34 sub seen {
35         my $ino = shift || die;
36         my $path = shift || die;
37         if(defined $inode_cash{$ino}) {
38                 #print STDERR "DEBUG($ino): $path\n";
39                 return 1;
40         }
41         $inode_cash{$ino}++;
42         return 0;
43 }
44
45 # Walk up a path and copy readable attributes from any
46 # directory level.
47 sub walk_up {
48         my $path = shift || die;
49         my $curr = $path;
50         # Walk up
51         for (my $curr = $path; $curr; $curr =~ s'/?[^/]+$'') {
52                 my ($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($curr);
53                 next if seen($ino, $curr);      # Skip visited directories
54                 # Scan directory
55                 opendir(my $d, $curr) || die "Failed opendir($curr): $!\n";
56                 my @entries = readdir $d;
57                 foreach my $entry (@entries) {
58                         next if $entry =~ /^[.][.]?$/;
59                         my $file = "$curr/$entry";
60                         my ($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($file);
61                         # Copy file
62                         if (-f _ && ($mode & 0004)) {   # The '-r _' is buggy
63                                 copy($file, "$destdir$file") ||
64                                         die "Failed to copy '$file': $!\n";
65                         }
66                 }
67                 closedir $d;
68         }
69 }
70
71 # Handle a given path (directory,symlink,regular-file)
72 sub handle_path {
73         my $path = shift || die;
74         my ($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($path);
75         # Save attributes before recursion starts
76         my $isdir = -d _;
77         my $islink = -l _;
78         my $isreadable = $mode & 00004; # The '-r _' was buggy
79         return if seen($ino, $path);    # Loop prevention
80         my $dest = "$destdir/$path";
81         if ($isdir) {
82                 mkpath("$dest");
83                 scan_directory($path);
84         } elsif ($islink) {
85                 # We follow links (the seen() protect us from loops)
86                 my $target = readlink($path) ||
87                         die "Failed readlink($path): $!\n";
88                 my $follow = $target;
89                 if ($target !~ m{^/}) { # fix relative symlinks
90                         my $dir = $path;
91                         $dir =~ s,/[^/]*$,,;
92                         $follow = realpath("$dir/$target");
93                 }
94                 # Save symlink details, so we create them after all
95                 # destination tree (subdirectories, files) is ready
96                 die "Duplicate entry '$dest'\n" if exists $symlinks{$dest};
97                 $symlinks{$dest} = "$target";
98                 # Now follow symlink
99                 handle_path($follow);
100                 $walk_ups{$follow}++;
101         } elsif ($isreadable) {
102                 copy($path, "$dest") ||
103                         die "Failed to copy '$path': $!\n";
104         }
105 }
106
107 # Scan a given directory (calling handle_path for recursion)
108 sub scan_directory {
109         my $dir = shift || die;
110         my $entry;
111         opendir(my $d, $dir) || die "Failed opendir($dir): $!\n";
112         my @dirs = readdir $d;
113         foreach my $entry (@dirs) {
114                 next if $entry =~ /^[.][.]?$/;
115                 handle_path("$dir/$entry");
116         }
117         closedir $d;
118 }
119
120 # Filter out non-existing toplevels
121 my @scan = grep { lstat($_) } @toplevels;
122
123 # Recurse all trees, creating subdirectories and copying files
124 foreach my $path (@scan) {
125         handle_path($path);
126 }
127
128 # Now, that all sub-directories were created, we can
129 # create the wanted symlinks
130 for my $dest (keys %symlinks) {
131         my $link = $symlinks{$dest};
132         die "Missing link for '$dest'\n" unless defined $link;
133         unlink $dest if -l $dest;
134         symlink($link,$dest) ||
135                 die "Failed symlink($link,$dest): $!\n";
136 }
137
138 # Walk up directories that were symlink destinations
139 # and fill their attributes
140 foreach my $dir (keys %walk_ups) {
141         walk_up($dir);
142 }