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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
|
#!/usr/bin/perl
use Getopt::Long;
GetOptions_('verbose', 'MonitorsDB', 'perl') && @ARGV == 1
or die "usage: monitor-probe-using-X [-v] [--perl] <X driver>\n";
my ($arg) = @ARGV;
my $log;
if (-e $arg) {
#- it is a log file
$log = cat_($arg);
parse_X_log($log);
} else {
my $Driver = $arg;
$log = probe_using_X($Driver) or warn("X probe failed\n"), exit 1;
my $ok = parse_X_log($log);
if ($ENV{DEBUG}) {
my $log_file = "/tmp/Xorg.log.$Driver";
output($log_file, $log);
warn "\n",
"Saving log in $log_file.\n",
$ok ? "If the detected resolution is wrong" :
"If it contains interesting information",
", send $log_file to pixel\@mandriva.com\n\n";
}
$ok or warn "Could not find a resolution\n";
}
sub GetOptions_ {
my (@l) = @_;
GetOptions('v' => \$opt{verbose}, map { $_ => \$opt{/([^=]*)/ && $1} } @l);
}
sub propagate_options {
my (@l) = @_;
map { $_ eq 'verbose' ? '-v' : "--$_" } grep { $opt{$_} } @l;
}
sub parse_edid() {
join(' ', 'monitor-parse-edid', propagate_options('verbose', 'MonitorsDB', 'perl'));
}
sub cat_ { open(my $F, $_[0]) or return; my @l = <$F>; wantarray() ? @l : join '', @l }
sub output { my $f = shift; open(my $F, ">$f") or die "output in file $f failed: $!\n"; print $F $_ foreach @_; 1 }
sub uniq { my %l; $l{$_} = 1 foreach @_; grep { delete $l{$_} } @_ }
sub tmpfile() {
chomp(my $s = `mktemp /tmp/tmp.XXXXXXXXXX`); #- we could use simply mktemp with new mktemp
eval "END { unlink '$s' }";
$s;
}
sub chvt {
my ($vt_number) = @_;
my $vt = '';
my ($VT_GETSTATE, $VT_ACTIVATE, $VT_WAITACTIVE) = (0x5603, 0x5606, 0x5607);
sysopen(my $C, "/dev/console", 2) or die "failed to open /dev/console: $!";
ioctl($C, $VT_GETSTATE, $vt) &&
ioctl($C, $VT_ACTIVATE, $vt_number) &&
ioctl($C, $VT_WAITACTIVE, $vt_number) or die "setVirtual failed";
unpack "S", $vt;
}
sub probe_using_X {
my ($Driver) = @_;
my $tmp_conf = tmpfile();
my $tmp_log = tmpfile();
output($tmp_conf, <<EOF);
Section "Files"
FontPath "/usr/lib/X11/fonts/misc:unscaled"
EndSection
Section "Device"
Identifier "device"
Driver "$Driver"
EndSection
Section "Screen"
Identifier "screen"
Device "device"
DefaultDepth 24
EndSection
Section "ServerLayout"
Identifier "layout"
Screen "screen"
EndSection
EOF
my $prev_vt = $Driver eq 'i810' && chvt(1); #- otherwise it can kill existing X
alarm 10;
my $ok = system("X :67 -ac -probeonly -logfile $tmp_log -config $tmp_conf") == 0;
alarm 0;
chvt($prev_vt) if $prev_vt;
if ($ok) {
my $log = cat_($tmp_log);
return $log;
} else {
return;
}
}
sub parse_X_log_edids {
my ($log) = @_;
my @edids;
while ($log =~ /: EDID \(in hex\):\n((.*\n){8})/g) {
my @lines = split '\n', $1;
my $edid = join('', map { /:\s+([0-9a-f]{32})$/ && $1 } @lines);
if (length $edid == 256) {
@edids = uniq(@edids, $edid);
} else {
warn "bad EDID found\n";
}
}
if (@edids) {
print "[\n" if $opt{perl};
foreach my $edid (@edids) {
open(my $F, '| ' . parse_edid());
print $F pack("C*", map { hex($_) } $edid =~ /(..)/g);
close $F;
print ",\n" if $opt{perl};
}
print "]\n" if $opt{perl};
}
@edids;
}
sub parse_X_log {
my ($log) = @_;
parse_X_log_edids($log) and return 1;
0
# i810 format: "Size of device %s is %d x %d\n" (i810/i830_driver.c)
# with one of "CRT", "TV", "DFP (digital flat panel)", "LFP (local flat panel)", "CRT2 (second CRT)", "TV2 (second TV)", "DFP2 (second digital flat panel)", "LFP2 (second local flat panel)",
# example: (II) I810(0): Size of device LFP (local flat panel) is 1024 x 768
|| $log =~ m!\bSize of device LFP \(local flat panel\) is (\d+) x (\d+)$!m
# ati format: "%dx%d panel (ID %d) detected.\n" (ati/atipreinit.c)
# example: (--) ATI(0): 1024x768 panel (ID 3) detected.
|| $log =~ m!\b(\d+)x(\d+) panel \(ID \d+\) detected\.$!m
# radeon format: "Panel Size from BIOS: %dx%d\n" (ati/radeon_bios.c)
# example: (II) RADEON(0): Panel Size from BIOS: 1400x1050
|| $log =~ m!\bPanel Size from BIOS: (\d+)x(\d+)$!m
# nv format: "Panel size is %i x %i\n" (nv/nv_setup.c)
# example: (--) NV(0): Panel size is 1280 x 800
|| $log =~ m!\bPanel size is (\d+) x (\d+)$!m
# savage format: "%dx%d %s LCD panel detected %s\n" (savage/savage_driver.c)
# with one of "TFT", "DSTN", "STN"
# and "and active", "but not active"
# example: (--) SAVAGE(0): 1024x768 TFT LCD panel detected and active
|| $log =~ m!\b(\d+)x(\d+) \S+ LCD panel detected !m
# neomagic format: "Panel is a %dx%d %s %s display\n" (neomagic/neo_driver.c)
# with one of "color", "monochrome"
# and "TFT", "dual scan"
# example: (--) NEOMAGIC(0): Panel is a 1024x768 color TFT display
|| $log =~ m!\bPanel is a (\d+)x(\d+) (?:color|monochrome) (?:TFT|dual scan) display$!m
# siliconmotion format: "Detected panel size via BIOS: %d x %d\n" (siliconmotion/smi_driver.c)
|| $log =~ m!\bDetected panel size via BIOS: (\d+) x (\d+)$!m
# siliconmotion format: "%s Panel Size = %dx%d\n" (siliconmotion/smi_driver.c)
|| $log =~ m! Panel Size = (\d+)x(\d+)$!m
# trident format: "%s Panel %ix%i found\n" (trident/trident_driver.c)
# with one of "TFT", "DSTN", "STN"
|| $log =~ m!\b(?:TFT|DSTN|STN) Panel (\d+)x(\d+) found$!m
# via format: "Selected Panel Size is 640x480\n", ... (via/via_driver.c)
|| $log =~ m!\bSelected Panel Size is (\d+)x(\d+)$!m
# (WW) intel(0): BIOS panel mode is bigger than probed programmed mode, continuing with BIOS mode.
# (II) intel(0): BIOS mode:
# (II) intel(0): Modeline "1280x800"x0.0 68.88 1280 1296 1344 1410 800 804 807 815 (48.9 kHz)
|| $log =~ m!BIOS panel mode is bigger than probed programmed mode, continuing with BIOS mode.*?BIOS mode:.*?Modeline "(\d+)x(\d+)"!s
or return;
my ($X, $Y) = ($1, $2);
print $opt{perl} ? "[ { preferred_resolution => { X => $X, Y => $Y } } ]" : "${X}x${Y}", "\n";
1;
}
|
