new build_tools/dahdi_sysfs_copy
authorOron Peled <oron.peled@xorcom.com>
Thu, 15 Mar 2012 20:40:52 +0000 (20:40 +0000)
committerTzafrir Cohen <tzafrir.cohen@xorcom.com>
Thu, 15 Mar 2012 20:40:52 +0000 (20:40 +0000)
Short perl script to copy dahdi related sysfs trees
into a designated directory.

Signed-off-by: Oron Peled <oron.peled@xorcom.com>
Acked-by: Tzafrir Cohen <tzafrir.cohen@xorcom.com>

git-svn-id: http://svn.astersk.org/svn/dahdi/tools/trunk@10496 17933a7a-c749-41c5-a318-cba88f637d49

build_tools/dahdi_sysfs_copy [new file with mode: 0755]

diff --git a/build_tools/dahdi_sysfs_copy b/build_tools/dahdi_sysfs_copy
new file mode 100755 (executable)
index 0000000..3460bb9
--- /dev/null
@@ -0,0 +1,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);
+}