dahdi-tools/build_tools/dahdi_sysfs_copy

143 lines
3.6 KiB
Plaintext
Raw Normal View History

#! /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);
}