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
192
193
194
195
196
|
# Copyright 2020-2024 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
# Helper functions to make it easier to write debuginfod tests.
# Return true if the debuginfod tests should be run, otherwise, return
# false.
proc allow_debuginfod_tests {} {
if [is_remote host] {
return false
}
if { [which debuginfod] == 0 } {
return false
}
if { [which curl] == 0 } {
untested "cannot find curl"
return false
}
# Skip testing if gdb was not configured with debuginfod.
#
# If GDB is built with ASan, it warns that some signal handlers
# (installed by ASan) exist on startup. That makes TCL's exec throw an
# error. Disable that by passing --quiet.
if { [string first "with-debuginfod" \
[eval exec $::GDB --quiet $::INTERNAL_GDBFLAGS \
--configuration]] == -1 } {
return false
}
return true
}
# Create two directories within the current output directory. One directory
# will be used by GDB as the client cache to hold downloaded debug
# information, and the other directory will be used by the debuginfod server
# as its cache of the parsed debug files that will be served to GDB.
#
# Call this proc with the names to two variables, these variables will be
# set in the parent scope with the paths to the two directories.
#
# This proc allocates the names for the directories, but doesn't create
# them. In fact, if the directories already exist, this proc will delete
# them, this ensures that any existing contents are also deleted.
proc prepare_for_debuginfod { cache_var db_var } {
upvar $cache_var cache
upvar $db_var db
set cache [standard_output_file ".client_cache"]
set db [standard_output_file ".debuginfod.db"]
# Delete any preexisting test files.
file delete -force $cache
file delete -force $db
}
# Run BODY with the three environment variables required to control
# debuginfod set. The timeout is set based on the usual timeouts used by
# GDB within dejagnu (see get_largest_timeout), the debuginfod cache is set
# to CACHE (this is where downloaded debug data is placed), and the
# debuginfod urls environment variable is set to be the empty string.
#
# Within BODY you should start a debuginfod server and set the environment
# variable DEBUGINFOD_URLS as appropriate (see start_debuginfod for details).
#
# The reason that this proc doesn't automatically start debuginfod, is that
# in some test cases we want to initially test with debuginfod not running
# and/or disabled.
proc with_debuginfod_env { cache body } {
set envlist \
[list \
env(DEBUGINFOD_URLS) \
env(DEBUGINFOD_TIMEOUT) \
env(DEBUGINFOD_CACHE_PATH)]
save_vars $envlist {
setenv DEBUGINFOD_TIMEOUT [get_largest_timeout]
setenv DEBUGINFOD_CACHE_PATH $cache
setenv DEBUGINFOD_URLS ""
uplevel 1 $body
}
}
# Start a debuginfod server. DB is the directory to use for the server's
# database cache, while DEBUGDIR is a directory containing all the debug
# information that the server should server.
#
# This proc will try to find an available port to start the server on, will
# start the server, and check that the server has started correctly.
#
# If the server starts correctly, then this proc will return the url that
# should be used to communicate with the server. If the server can't be
# started, then an error will be printed, and an empty string returned.
#
# If the server is successfully started then the global variable
# debuginfod_spawn_id will be set with the spawn_id of the debuginfod
# process.
proc start_debuginfod { db debugdir } {
global debuginfod_spawn_id spawn_id
# Find an unused port.
set port 7999
set found false
while { ! $found } {
incr port
if { $port == 65536 } {
perror "no available ports"
return ""
}
if { [info exists spawn_id] } {
set old_spawn_id $spawn_id
}
spawn debuginfod -vvvv -d $db -p $port -F $debugdir
set debuginfod_spawn_id $spawn_id
if { [info exists old_spawn_id] } {
set spawn_id $old_spawn_id
unset old_spawn_id
}
expect {
-i $debuginfod_spawn_id
"started http server on IPv4 IPv6 port=$port" { set found true }
"started http server on IPv4 port=$port" { set found true }
"started http server on IPv6 port=$port" {}
"failed to bind to port" {}
timeout {
stop_debuginfod
perror "find port timeout"
return ""
}
}
if { ! $found } {
stop_debuginfod
}
}
set url "http://127.0.0.1:$port"
set metrics [list "ready 1" \
"thread_work_total{role=\"traverse\"} 1" \
"thread_work_pending{role=\"scan\"} 0" \
"thread_busy{role=\"scan\"} 0"]
# Check server metrics to confirm init has completed.
foreach m $metrics {
set timelim 20
while { $timelim != 0 } {
sleep 0.5
catch {exec curl -s $url/metrics} got
if { [regexp $m $got] } {
break
}
incr timelim -1
}
if { $timelim == 0 } {
stop_debuginfod
perror "server init timeout"
return ""
}
}
return $url
}
# If the global debuginfod_spawn_id exists, then kill that process and unset
# the debuginfod_spawn_id global. This can be used to shutdown the
# debuginfod server.
proc stop_debuginfod { } {
global debuginfod_spawn_id
if [info exists debuginfod_spawn_id] {
kill_wait_spawned_process $debuginfod_spawn_id
unset debuginfod_spawn_id
}
}
|
