]> git.proxmox.com Git - qemu-server.git/blob - pcitest.pl
d/control: bump version dependency on libpve-guest-common-perl
[qemu-server.git] / pcitest.pl
1 #!/usr/bin/perl
2
3 # this is some experimental code to test pci pass through
4
5 use strict;
6 use warnings;
7 use IO::Dir;
8 use IO::File;
9 use Time::HiRes qw(usleep);
10 use Data::Dumper;
11
12 # linux/Documentation/filesystems/sysfs-pci.txt
13 # linux/DocumentationABI/testing/sysfs-bus-pci
14
15 use constant {
16 PCI_STATUS => 0x06,
17 PCI_CONF_HEADER_LEN => 0x40,
18 PCI_STATUS_CAP_LIST => 0x10,
19 PCI_CAPABILITY_LIST => 0x34,
20 PCI_CAP_ID_PM => 0x01,
21 PCI_PM_CTRL => 0x04,
22 PCI_PM_CTRL_STATE_MASK => 0x03,
23 PCI_PM_CTRL_STATE_D0 => 0x00,
24 PCI_PM_CTRL_STATE_D3hot => 0x03,
25 PCI_PM_CTRL_NO_SOFT_RESET => 0x08,
26 };
27
28 my $pcisysfs = "/sys/bus/pci";
29
30 sub file_read_firstline {
31 my ($filename) = @_;
32
33 my $fh = IO::File->new ($filename, "r");
34 return undef if !$fh;
35 my $res = <$fh>;
36 chomp $res;
37 $fh->close;
38 return $res;
39 }
40
41 sub file_read {
42 my ($filename) = @_;
43
44 my $fh = IO::File->new ($filename, "r");
45 return undef if !$fh;
46
47 local $/ = undef; # enable slurp mode
48 my $content = <$fh>;
49 $fh->close();
50
51 return $content;
52 }
53
54 sub file_write {
55 my ($filename, $buf) = @_;
56
57 my $fh = IO::File->new ($filename, "w");
58 return undef if !$fh;
59
60 my $res = print $fh $buf;
61
62 $fh->close();
63
64 return $res;
65 }
66
67 sub read_pci_config {
68 my $name = shift;
69
70 return file_read ("$pcisysfs/devices/$name/config");
71 }
72
73 sub pci_config_write {
74 my ($name, $pos, $buf) = @_;
75
76 my $filename = "$pcisysfs/devices/$name/config";
77
78 my $fh = IO::File->new ($filename, "w");
79 return undef if !$fh;
80
81 if (sysseek($fh, $pos, 0) != $pos) {
82 print "PCI WRITE seek failed\n";
83 return undef;
84 }
85
86 my $res = syswrite ($fh, $buf);
87 print "PCI WRITE $res\n";
88
89 $fh->close();
90
91 return $res;
92 }
93
94 sub pci_config_read {
95 my ($conf, $pos, $fmt) = @_;
96
97 my $len;
98 if ($fmt eq 'C') {
99 $len = 1;
100 } elsif ($fmt eq 'S') {
101 $len = 2;
102 } elsif ($fmt eq 'L') {
103 $len = 4;
104 } else {
105 return undef;
106 }
107 return undef if (($pos < 0) || (($pos + $len) > length($conf)));
108
109 return unpack($fmt, substr($conf, $pos, $len));
110 }
111
112
113 sub pci_device_list {
114
115 my $res = {};
116
117 my $dh = IO::Dir->new ("$pcisysfs/devices") || return $res;
118
119 my $used_irqs;
120
121 if ($dh) {
122 while (defined(my $name = $dh->read)) {
123 if ($name =~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/i) {
124 my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
125
126 my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
127 next if $irq !~ m/^\d+$/;
128
129 my $irq_is_shared = defined($used_irqs->{$irq}) || 0;
130 $used_irqs->{$irq} = 1;
131
132 my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
133 next if $vendor !~ s/^0x//;
134 my $product = file_read_firstline("$pcisysfs/devices/$name/device");
135 next if $product !~ s/^0x//;
136
137 my $conf = read_pci_config ($name);
138 next if !$conf;
139
140 $res->{$name} = {
141 vendor => $vendor,
142 product => $product,
143 domain => $domain,
144 bus => $bus,
145 slot => $slot,
146 func => $func,
147 irq => $irq,
148 irq_is_shared => $irq_is_shared,
149 has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
150 };
151
152
153 my $status = pci_config_read ($conf, PCI_STATUS, 'S');
154 next if !defined ($status) || (!($status & PCI_STATUS_CAP_LIST));
155
156 my $pos = pci_config_read ($conf, PCI_CAPABILITY_LIST, 'C');
157 while ($pos && $pos > PCI_CONF_HEADER_LEN && $pos != 0xff) {
158 my $capid = pci_config_read ($conf, $pos, 'C');
159 last if !defined ($capid);
160 $res->{$name}->{cap}->{$capid} = $pos;
161 $pos = pci_config_read ($conf, $pos + 1, 'C');
162 }
163
164 #print Dumper($res->{$name});
165 my $capid = PCI_CAP_ID_PM;
166 if (my $pm_cap_off = $res->{$name}->{cap}->{$capid}) {
167 # require the NO_SOFT_RESET bit is clear
168 my $ctl = pci_config_read ($conf, $pm_cap_off + PCI_PM_CTRL, 'L');
169 if (defined ($ctl) && !($ctl & PCI_PM_CTRL_NO_SOFT_RESET)) {
170 $res->{$name}->{has_pm_reset} = 1;
171 }
172 }
173 }
174 }
175 }
176
177 return $res;
178 }
179
180 sub pci_pm_reset {
181 my ($list, $name) = @_;
182
183 print "trying to reset $name\n";
184
185 my $dev = $list->{$name} || die "no such pci device '$name";
186
187 my $capid = PCI_CAP_ID_PM;
188 my $pm_cap_off = $list->{$name}->{cap}->{$capid};
189
190 return undef if !defined ($pm_cap_off);
191 return undef if !$dev->{has_pm_reset};
192
193 my $conf = read_pci_config ($name) || die "cant read pci config";
194
195 my $ctl = pci_config_read ($conf, $pm_cap_off + PCI_PM_CTRL, 'L');
196 return undef if !defined ($ctl);
197
198 $ctl = $ctl & ~PCI_PM_CTRL_STATE_MASK;
199
200 pci_config_write($name, $pm_cap_off + PCI_PM_CTRL,
201 pack ('L', $ctl|PCI_PM_CTRL_STATE_D3hot));
202
203 usleep(10000); # 10ms
204
205 pci_config_write($name, $pm_cap_off + PCI_PM_CTRL,
206 pack ('L', $ctl|PCI_PM_CTRL_STATE_D0));
207
208 usleep(10000); # 10ms
209
210 return pci_config_write($name, 0, $conf);
211 }
212
213 sub pci_dev_reset {
214 my ($list, $name) = @_;
215
216 print "trying to reset $name\n";
217
218 my $dev = $list->{$name} || die "no such pci device '$name";
219
220 my $fn = "$pcisysfs/devices/$name/reset";
221
222 return file_write ($fn, "1");
223 }
224
225
226 sub pci_dev_bind_to_stub {
227 my ($list, $name) = @_;
228
229 my $dev = $list->{$name} || die "no such pci device '$name";
230
231 #return undef if $dev->{irq_is_shared};
232
233 my $testdir = "$pcisysfs/drivers/pci-stub/$name";
234 return 1 if -d $testdir;
235
236 my $data = "$dev->{vendor} $dev->{product}";
237 return undef if !file_write ("$pcisysfs/drivers/pci-stub/new_id", $data);
238
239 my $fn = "$pcisysfs/devices/$name/driver/unbind";
240 if (!file_write ($fn, $name)) {
241 return undef if -f $fn;
242 }
243
244 $fn = "$pcisysfs/drivers/pci-stub/bind";
245 if (! -d $testdir) {
246 return undef if !file_write ($fn, $name);
247 }
248
249 return -d $testdir;
250 }
251
252 sub pci_dev_unbind_from_stub {
253 my ($list, $name) = @_;
254
255 my $dev = $list->{$name} || die "no such pci device '$name";
256
257 #return undef if $dev->{irq_is_shared};
258
259 my $testdir = "$pcisysfs/drivers/pci-stub/$name";
260 return 1 if ! -d $testdir;
261
262 my $data = "$dev->{vendor} $dev->{product}";
263 file_write ("$pcisysfs/drivers/pci-stub/remove_id", $data);
264
265 return undef if !file_write ("$pcisysfs/drivers/pci-stub/unbind", $name);
266
267 return ! -d $testdir;
268 }
269
270 my $devlist = pci_device_list();
271 print Dumper($devlist);
272
273 my $name = $ARGV[0] || exit 0;
274
275 if (!pci_dev_bind_to_stub($devlist, $name)) {
276 print "failed\n";
277 exit (-1);
278 }
279 if (!pci_dev_unbind_from_stub($devlist, $name)) {
280 print "failed\n";
281 exit (-1);
282 }
283
284 #pci_pm_reset ($devlist, $name);
285
286 if (!pci_dev_reset ($devlist, $name)) {
287 print "reset failed\n";
288 exit (-1);
289 }
290
291
292 exit 0;