gdb/testsuite/lib/debuginfod-support.exp

   1 # Copyright 2020-2023 Free Software Foundation, Inc.
   2
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 3 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15
  16 # Helper functions to make it easier to write debuginfod tests.
  17
  18 # Return true if the debuginfod tests should be skipped, otherwise, return
  19 # false.
  20 proc skip_debuginfod_tests {} {
  21     if [is_remote host] {
  22         return true
  23     }
  24
  25     if { [which debuginfod] == 0 } {
  26         return true
  27     }
  28
  29     if { [which curl] == 0 } {
  30         untested "cannot find curl"
  31         return true
  32     }
  33
  34     # Skip testing if gdb was not configured with debuginfod.
  35     #
  36     # If GDB is built with ASan, it warns that some signal handlers
  37     # (installed by ASan) exist on startup.  That makes TCL's exec throw an
  38     # error.  Disable that by passing --quiet.
  39     if { [string first "with-debuginfod" \
  40               [eval exec $::GDB --quiet $::INTERNAL_GDBFLAGS \
  41                    --configuration]] == -1 } {
  42         return true
  43     }
  44
  45     return false
  46 }
  47
  48 # Create two directories within the current output directory.  One directory
  49 # will be used by GDB as the client cache to hold downloaded debug
  50 # information, and the other directory will be used by the debuginfod server
  51 # as its cache of the parsed debug files that will be served to GDB.
  52 #
  53 # Call this proc with the names to two variables, these variables will be
  54 # set in the parent scope with the paths to the two directories.
  55 #
  56 # This proc allocates the names for the directories, but doesn't create
  57 # them.  In fact, if the directories already exist, this proc will delete
  58 # them, this ensures that any existing contents are also deleted.
  59 proc prepare_for_debuginfod { cache_var db_var } {
  60     upvar $cache_var cache
  61     upvar $db_var db
  62
  63     set cache [standard_output_file ".client_cache"]
  64     set db [standard_output_file ".debuginfod.db"]
  65
  66     # Delete any preexisting test files.
  67     file delete -force $cache
  68     file delete -force $db
  69 }
  70
  71 # Run BODY with the three environment variables required to control
  72 # debuginfod set.  The timeout is set based on the usual timeouts used by
  73 # GDB within dejagnu (see get_largest_timeout), the debuginfod cache is set
  74 # to CACHE (this is where downloaded debug data is placed), and the
  75 # debuginfod urls environment variable is set to be the empty string.
  76 #
  77 # Within BODY you should start a debuginfod server and set the environment
  78 # variable DEBUGINFOD_URLS as appropriate (see start_debuginfod for details).
  79 #
  80 # The reason that this proc doesn't automatically start debuginfod, is that
  81 # in some test cases we want to initially test with debuginfod not running
  82 # and/or disabled.
  83 proc with_debuginfod_env { cache body } {
  84     set envlist \
  85         [list \
  86              env(DEBUGINFOD_URLS) \
  87              env(DEBUGINFOD_TIMEOUT) \
  88              env(DEBUGINFOD_CACHE_PATH)]
  89
  90     save_vars $envlist {
  91         setenv DEBUGINFOD_TIMEOUT [get_largest_timeout]
  92         setenv DEBUGINFOD_CACHE_PATH $cache
  93         setenv DEBUGINFOD_URLS ""
  94
  95         uplevel 1 $body
  96     }
  97 }
  98
  99 # Start a debuginfod server.  DB is the directory to use for the server's
 100 # database cache, while DEBUGDIR is a directory containing all the debug
 101 # information that the server should server.
 102 #
 103 # This proc will try to find an available port to start the server on, will
 104 # start the server, and check that the server has started correctly.
 105 #
 106 # If the server starts correctly, then this proc will return the url that
 107 # should be used to communicate with the server.  If the server can't be
 108 # started, then an error will be printed, and an empty string returned.
 109 #
 110 # If the server is successfully started then the global variable
 111 # debuginfod_spawn_id will be set with the spawn_id of the debuginfod
 112 # process.
 113 proc start_debuginfod { db debugdir } {
 114     global debuginfod_spawn_id spawn_id
 115
 116     # Find an unused port.
 117     set port 7999
 118     set found false
 119     while { ! $found } {
 120         incr port
 121         if { $port == 65536 } {
 122             perror "no available ports"
 123             return ""
 124         }
 125
 126         if { [info exists spawn_id] } {
 127             set old_spawn_id $spawn_id
 128         }
 129
 130         spawn debuginfod -vvvv -d $db -p $port -F $debugdir
 131         set debuginfod_spawn_id $spawn_id
 132
 133         if { [info exists old_spawn_id] } {
 134             set spawn_id $old_spawn_id
 135             unset old_spawn_id
 136         }
 137
 138         expect {
 139             -i $debuginfod_spawn_id
 140             "started http server on IPv4 IPv6 port=$port" { set found true }
 141             "started http server on IPv4 port=$port" { set found true }
 142             "started http server on IPv6 port=$port" {}
 143             "failed to bind to port" {}
 144             timeout {
 145                 stop_debuginfod
 146                 perror "find port timeout"
 147                 return ""
 148             }
 149         }
 150         if { ! $found } {
 151             stop_debuginfod
 152         }
 153     }
 154
 155     set url "http://127.0.0.1:$port"
 156
 157     set metrics [list "ready 1" \
 158                      "thread_work_total{role=\"traverse\"} 1" \
 159                      "thread_work_pending{role=\"scan\"} 0" \
 160                      "thread_busy{role=\"scan\"} 0"]
 161
 162     # Check server metrics to confirm init has completed.
 163     foreach m $metrics {
 164         set timelim 20
 165         while { $timelim != 0 } {
 166             sleep 0.5
 167             catch {exec curl -s $url/metrics} got
 168
 169             if { [regexp $m $got] } {
 170                 break
 171             }
 172
 173             incr timelim -1
 174         }
 175
 176         if { $timelim == 0 } {
 177             stop_debuginfod
 178             perror "server init timeout"
 179             return ""
 180         }
 181     }
 182
 183     return $url
 184 }
 185
 186 # If the global debuginfod_spawn_id exists, then kill that process and unset
 187 # the debuginfod_spawn_id global.  This can be used to shutdown the
 188 # debuginfod server.
 189 proc stop_debuginfod { } {
 190     global debuginfod_spawn_id
 191
 192     if [info exists debuginfod_spawn_id] {
 193         kill_wait_spawned_process $debuginfod_spawn_id
 194         unset debuginfod_spawn_id
 195     }
 196 }