Home | History | Annotate | Line # | Download | only in lib 
      1 # Copyright 2020-2024 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 run, otherwise, return
     19 # false.
     20 proc allow_debuginfod_tests {} {
     21     if [is_remote host] {
     22 	return false
     23     }
     24 
     25     if { [which debuginfod] == 0 } {
     26 	return false
     27     }
     28 
     29     if { [which curl] == 0 } {
     30 	untested "cannot find curl"
     31 	return false
     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.  This is dealt with by the --quiet in INTERNAL_GDBFLAGS.
     39     if { [string first "with-debuginfod" \
     40 	      [eval exec $::GDB $::INTERNAL_GDBFLAGS \
     41 		   --configuration]] == -1 } {
     42 	return false
     43     }
     44 
     45     return true
     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 }
    197