← Back to branch summary

~ubuntu-branches/ubuntu/saucy/dahdi-tools/saucy-proposed

« back to all changes in this revision

Viewing changes to build_tools/dahdi_sysfs_copy

  • Committer: Package Import Robot
  • Author(s): Jackson Doak
  • Date: 2013-08-25 12:48:37 UTC
  • mfrom: (2.1.7 sid)
  • Revision ID: package-import@ubuntu.com-20130825124837-wtefi7f9dsihg8is
Tags: 1:2.7.0-1ubuntu1
* Merge from debian. Remaining changes:
  - debian/control: Added gawk as dependency for dkms build
  - debian/control: Package dahdi Depends on dahdi-dkms | dahdi-source
  - debian/control: Set ubuntu maintainer    
  - added debian/dahdi.postinst
  - debian/control: Removed Uploaders field.
  - added debian/dahdi.postinst
  - added --error-handler=init_failed to debian/rules
  

Show diffs side-by-side

added added

removed removed

Lines of Context:
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
}