summaryrefslogtreecommitdiffstats
path: root/perl-install/modalias.pm
blob: e1b61edc02133a5b41e79a09135f3ab672728a79 (plain)
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
package modalias;

# TODO:
# - be faster (Elapsed time: lspcidrake.pl ~ 0.28s instead of 0.12s for old lspcidrake

use strict;
use MDK::Common;
use c;

my @config_groups = (
    [
	"/lib/module-init-tools/modprobe.default",
	"/etc/modprobe.conf",
	"/etc/modprobe.d",
    ],
);
my @system_groups = (
    [
        "/lib/module-init-tools/ldetect-lst-modules.alias",
    ],
    [
        "/lib/modules/" . c::kernel_version() . "/modules.alias",
    ],
);
my @classes = qw(ide ieee1394 input pci pcmcia pnp serio usb);
my @alias_groups;

my $alias_re = qr/^\s*alias\s+(([^:]+):\S+)\s+(\S+)$/;

sub alias_to_ids {
    my ($alias) = @_;
    my ($vendor, $device);
    # returns (vendor, device)
    if (($vendor, $device) = $alias =~ /:v([0-9A-F]{4})[dp]([0-9A-F]{4})/) {
        return ($vendor, $device);
    } elsif (($vendor, $device) = $alias =~ /:v0{4}([0-9A-F]{4})[dp]0{4}([0-9A-F]{4})/) {
        return ($vendor, $device);
    }
}

sub parse_path {
    my ($group, $path) = @_;
    if (-d $path) {
        parse_path($group, "$path/$_") foreach all($path);
    } elsif (-f $path) {
        foreach (cat_($path)) {
            if (my ($alias, $class, $module) = $_ =~ $alias_re) {
                if (member($class, @classes)) {
                    my ($vendor, $device) = alias_to_ids($alias);
                    if ($vendor) {
                        $group->{$class} ||= {};
                        $group->{$class}{$vendor} ||= {};
                        $group->{$class}{$vendor}{$device} ||= [];
                        push @{$group->{$class}{$vendor}{$device}}, $alias, $module;
                    } else {
                        push @{$group->{$class}{other}}, $alias, $module;
                    }
                }
            }
        }
    }
}

sub parse_file_modules {
    my ($path) = @_;
    my %modules;
    foreach (cat_($path)) {
        if (my ($alias, undef, $module) = $_ =~ $alias_re) {
            push @{$modules{$module}}, $alias;
        }
    }
    \%modules;
}

sub get_alias_groups {
    my ($o_skip_config) = @_;
    #- FIXME: only o_skip_config from the first call is considered
    @alias_groups = map {
        my $group = {};
        parse_path($group, $_) foreach @$_;
        $group;
    } if_(!$o_skip_config, @config_groups), @system_groups unless @alias_groups;
    @alias_groups;
}

sub get_modules {
    my ($modalias, $o_skip_config) = @_;
    my ($class) = $modalias =~ /^([^:]+):\S+$/;
    my ($vendor, $device) = alias_to_ids($modalias);
    $class && member($class, @classes) or return;

    require File::FnMatch;
    foreach my $group (get_alias_groups($o_skip_config)) {
        my @aliases;
        foreach my $subgroup ($group->{$class}{$vendor}{$device}, $group->{$class}{other}) {
            foreach (group_by2(@$subgroup)) {
                File::FnMatch::fnmatch($_->[0], $modalias) and push @aliases, $_->[1];
            }
        }
        return uniq(@aliases) if @aliases;
    }
}

1;