[deliverable/binutils-gdb.git] / gdb / testsuite / lib / prelink-support.exp

# Copyright (C) 2010-2022 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/>.

# Return nul-terminated string read from section SECTION of EXEC.  Return ""
# if no such section or nul-terminated string was found.  Function is useful
# for sections ".interp" or ".gnu_debuglink".

proc section_get {exec section} {
    global subdir
    set tmp [standard_output_file section_get.tmp]
    set objcopy_program [gdb_find_objcopy]

    set command "exec $objcopy_program -O binary --set-section-flags $section=A --change-section-address $section=0 -j $section $exec $tmp"
    verbose -log "command is $command"
    set result [catch $command output]
    verbose -log "result is $result"
    verbose -log "output is $output"
    if {$result == 1} {
	return ""
    }
    set fi [open $tmp]
    fconfigure $fi -translation binary
    set data [read $fi]
    close $fi
    file delete $tmp
    # .interp has size $len + 1 but .gnu_debuglink contains garbage after \000.
    set len [string first \000 $data]
    if {$len < 0} {
	verbose -log "section $section not found"
	return ""
    }
    set retval [string range $data 0 [expr $len - 1]]
    verbose -log "section $section is <$retval>"
    return $retval
}

# Resolve symlinks.

proc symlink_resolve {file} {
    set loop 0
    while {[file type $file] == "link"} {
	set target [file readlink $file]
	if {[file pathtype $target] == "relative"} {
	    set src2 [file dirname $file]/$target
	} else {
	    set src2 $target
	}
	verbose -log "Resolved symlink $file targetting $target as $src2"
	set file $src2

	set loop [expr $loop + 1]
	if {$loop > 30} {
	    fail "looping symlink resolution for $file"
	    return ""
	}
    }
    return $file
}

# Copy SRC to DEST, resolving any symlinks in SRC.  Return nonzero iff
# the copy was succesful.
#
# This function is guaranteed to never raise any exception, even when the copy
# fails.

proc file_copy {src dest} {
    set src [symlink_resolve $src]
    # Test name would contain unstable directory name for symlink-unresolved
    # $src.
    set test "copy [file tail $src] to [file tail $dest]"
    set command "file copy -force -- $src $dest"
    verbose -log "command is $command"
    if [catch $command] {
	fail $test
	return 0
    } else {
    	pass $test
	return 1
    }
}

# Wrap function build_executable so that the resulting executable is fully
# self-sufficient (without dependencies on system libraries).  Parameter
# INTERP may be used to specify a loader (ld.so) to be used that is
# different from the default system one.  INTERP can be set to "no" if no ld.so
# copy should be made.  Libraries on which the executable depends are copied
# into directory DIR.  Default DIR value to
# `${objdir}/${subdir}/${EXECUTABLE}.d'.
#
# In case of success, return a string containing the arguments to be used
# in order to perform a prelink of the executable obtained.  Return the
# empty string in case of failure.
#
# This can be useful when trying to prelink an executable which might
# depend on system libraries.  To properly prelink an executable, all
# of its dynamically linked libraries must be prelinked as well.  If
# the executable depends on some system libraries, we may not have
# sufficient write priviledges on these files to perform the prelink.
# This is why we make a copy of these shared libraries, and link the
# executable against these copies instead.
#
# Function recognizes only libraries listed by `ldd' after
# its ` => ' separator.  That means $INTERP and any libraries not being linked
# with -Wl,-soname,NAME.so are not copied.

proc build_executable_own_libs {testname executable sources options {interp ""} {dir ""}} {
    global subdir

    if { ![isnative] } {
	error "This proc can be only used for native target."
    }

    with_test_prefix "initial build" {
	if {[build_executable $testname $executable $sources $options] == -1} {
	    return ""
	}
    }
    set binfile [standard_output_file ${executable}]

    set ldd [gdb_find_ldd]
    set command "$ldd $binfile"
    set test "ldd $executable"
    set result [catch "exec $command" output]
    verbose -log "result of $command is $result"
    verbose -log "output of $command is $output"
    if {$result != 0 || $output == ""} {
	fail $test
    } else {
	pass $test
    }

    # gdb testsuite will put there also needless -lm.
    set test "$test output contains libs"
    set libs [regexp -all -inline -line {^.* => (/[^ ]+).*$} $output]
    if {[llength $libs] == 0} {
	fail $test
    } else {
	pass $test
    }

    if {$dir == ""} {
	set dir ${binfile}.d
    }
    file delete -force -- $dir
    file mkdir $dir

    if {$interp == ""} {
	set interp_system [section_get $binfile .interp]
	if {$interp_system == ""} {
	    fail "$test could not find .interp"
	} else {
	    set interp ${dir}/[file tail $interp_system]
	    file_copy $interp_system $interp
	}
    }
    if {$interp == "no"} {
	set interp ""
    }

    set dests {}
    foreach {trash abspath} $libs {
	set dest "$dir/[file tail $abspath]"
	file_copy $abspath $dest
	lappend dests $dest
    }

    # Do not lappend it so that "-rpath $dir" overrides any possible "-rpath"s
    # specified by the caller to be able to link it for ldd" above.
    set options [linsert $options 0 "ldflags=-Wl,-rpath,$dir"]
    if {$interp != ""} {
	set options [linsert $options 0 "ldflags=-Wl,--dynamic-linker,$interp"]
    }

    with_test_prefix "rebuild" {
	if {[build_executable $testname $executable $sources $options] == -1} {
	    return ""
	}
    }

    set prelink_args "--ld-library-path=$dir $binfile [concat $dests]"
    if {$interp != ""} {
	set prelink_args "--dynamic-linker=$interp $prelink_args $interp"
    }
    return $prelink_args
}

# Unprelink ARG.  Reported test name can be specified by NAME.  Return non-zero
# on success, zero on failure.

proc prelink_no {arg {name {}}} {
    if {$name == ""} {
	set name [file tail $arg]
    }
    set test "unprelink $name"
    set command "exec /usr/sbin/prelink -uN $arg"
    verbose -log "command is $command"
    set result [catch $command output]
    verbose -log "result is $result"
    verbose -log "output is $output"
    if {$result == 1 && [regexp {^(couldn't execute "/usr/sbin/prelink[^\r\n]*": no such file or directory\n?)*$} $output]} {
	# Without prelink, at least verify that all the binaries do not
	# contain the  ".gnu.prelink_undo" section (which would mean that they
	# have already been prelinked).
	set test "$test (missing /usr/sbin/prelink)"
	foreach bin [split $arg] {
	    if [string match "-*" $bin] {
		# Skip prelink options.
		continue
	    }
	    set readelf_program [gdb_find_readelf]
	    set command "exec $readelf_program -WS $bin"
	    verbose -log "command is $command"
	    set result [catch $command output]
	    verbose -log "result is $result"
	    verbose -log "output is $output"
	    if {$result != 0 || [string match {* .gnu.prelink_undo *} $output]} {
		fail "$test ($bin is already prelinked)"
		return 0
	    }
	}
	pass $test
	return 1
    }
    if {$result == 0 && $output == ""} {
	verbose -log "$name has been now unprelinked"
	set command "exec /usr/sbin/prelink -uN $arg"
	verbose -log "command is $command"
	set result [catch $command output]
	verbose -log "result is $result"
	verbose -log "output is $output"
    }
    # Last line does miss the trailing \n.  There can be multiple such messages
    # as ARG may list multiple files.
    if {$result == 1 && [regexp {^([^\r\n]*prelink[^\r\n]*: [^ ]* does not have .gnu.prelink_undo section\n?)*$} $output]} {
	pass $test
	return 1
    } else {
	fail $test
	return 0
    }
}

# Prelink ARG.  Reported test name can be specified by NAME.  Return non-zero
# on success, zero on failure.

proc prelink_yes {arg {name ""}} {
    if {$name == ""} {
	set name [file tail $arg]
    }

    # Try to unprelink it first so that, if it has been already prelinked
    # before, we get a different address now, making the new result unaffected
    # by any previous prelinking.
    if ![prelink_no $arg "$name pre-unprelink"] {
	return 0
    }

    set test "prelink $name"

    # `--no-exec-shield' is for i386, where prelink in the exec-shield mode is
    # forced to push all the libraries tight together, in order to fit into
    # the first two memory areas (either the ASCII Shield area or at least
    # below the executable).  If the prelink was performed in exec-shield
    # mode, prelink could have no choice on how to randomize the single new
    # unprelinked library address without wasting space in the first one/two
    # memory areas.  In such case prelink could place $ARG repeatedly at the
    # same place and we could have false prelink results on
    # gdb.base/prelink.exp and others.  To prevent this from happening, we use
    # the --no-exec-shield switch.  This may have some consequences in terms
    # of security, but we do not care in our case.

    set command "exec /usr/sbin/prelink -qNR --no-exec-shield $arg"

    verbose -log "command is $command"
    set result [catch $command output]
    verbose -log "result is $result"
    verbose -log "output is $output"
    if {$result == 1 && [regexp {^(couldn't execute "/usr/sbin/prelink[^\r\n]*": no such file or directory\n?)*$} $output]} {
	set test "$test (missing /usr/sbin/prelink)"

	# We could not find prelink.  We could check whether $args is already
	# prelinked but we don't, because:
	#   - It is unlikely that someone uninstalls prelink after having
	#     prelinked the system ld.so;
	#   - We still cannot change its prelinked address.
	# Therefore, we just skip the test.

	xfail $test
	return 0
    }
    if {$result == 1 && [regexp {DWARF [^\r\n]* unhandled} $output]} {
	# Prelink didn't understand the version of dwarf present.
	unsupported "$test (dwarf version unhandled)"
	return 0
    }
    if {$result == 0 && $output == ""} {
	pass $test
	return 1
    } elseif {$result == 1 \
	      && [string match -nocase "*: Not enough room to add .dynamic entry" $output]} {
	# Linker should have reserved some entries for prelink.
	xfail $test
	return 0
    } else {
	fail $test
	return 0
    }
}
Commit	Line	Data
88b9d363	1	# Copyright (C) 2010-2022 Free Software Foundation, Inc.
5e3b36f8 JK	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	# Return nul-terminated string read from section SECTION of EXEC. Return ""
	17	# if no such section or nul-terminated string was found. Function is useful
	18	# for sections ".interp" or ".gnu_debuglink".
	19
	20	proc section_get {exec section} {
5e3b36f8	21	global subdir
53e981d9	22	set tmp [standard_output_file section_get.tmp]
4fa7d390	23	set objcopy_program [gdb_find_objcopy]
5e3b36f8 JK	24
	25	set command "exec $objcopy_program -O binary --set-section-flags $section=A --change-section-address $section=0 -j $section $exec $tmp"
	26	verbose -log "command is $command"
	27	set result [catch $command output]
	28	verbose -log "result is $result"
	29	verbose -log "output is $output"
	30	if {$result == 1} {
	31	return ""
	32	}
	33	set fi [open $tmp]
	34	fconfigure $fi -translation binary
	35	set data [read $fi]
	36	close $fi
	37	file delete $tmp
	38	# .interp has size $len + 1 but .gnu_debuglink contains garbage after \000.
	39	set len [string first \000 $data]
	40	if {$len < 0} {
	41	verbose -log "section $section not found"
	42	return ""
	43	}
	44	set retval [string range $data 0 [expr $len - 1]]
	45	verbose -log "section $section is <$retval>"
	46	return $retval
	47	}
	48
	49	# Resolve symlinks.
	50
	51	proc symlink_resolve {file} {
	52	set loop 0
	53	while {[file type $file] == "link"} {
	54	set target [file readlink $file]
	55	if {[file pathtype $target] == "relative"} {
	56	set src2 [file dirname $file]/$target
	57	} else {
	58	set src2 $target
	59	}
	60	verbose -log "Resolved symlink $file targetting $target as $src2"
	61	set file $src2
	62
	63	set loop [expr $loop + 1]
	64	if {$loop > 30} {
bc6c7af4	65	fail "looping symlink resolution for $file"
5e3b36f8 JK	66	return ""
	67	}
	68	}
	69	return $file
	70	}
	71
	72	# Copy SRC to DEST, resolving any symlinks in SRC. Return nonzero iff
	73	# the copy was succesful.
	74	#
	75	# This function is guaranteed to never raise any exception, even when the copy
	76	# fails.
	77
	78	proc file_copy {src dest} {
	79	set src [symlink_resolve $src]
	80	# Test name would contain unstable directory name for symlink-unresolved
	81	# $src.
	82	set test "copy [file tail $src] to [file tail $dest]"
	83	set command "file copy -force -- $src $dest"
	84	verbose -log "command is $command"
	85	if [catch $command] {
	86	fail $test
	87	return 0
	88	} else {
	89	pass $test
	90	return 1
	91	}
	92	}
	93
	94	# Wrap function build_executable so that the resulting executable is fully
	95	# self-sufficient (without dependencies on system libraries). Parameter
	96	# INTERP may be used to specify a loader (ld.so) to be used that is
a29a3fb7 GB	97	# different from the default system one. INTERP can be set to "no" if no ld.so
	98	# copy should be made. Libraries on which the executable depends are copied
	99	# into directory DIR. Default DIR value to
5e3b36f8 JK	100	# `${objdir}/${subdir}/${EXECUTABLE}.d'.
	101	#
	102	# In case of success, return a string containing the arguments to be used
	103	# in order to perform a prelink of the executable obtained. Return the
	104	# empty string in case of failure.
	105	#
	106	# This can be useful when trying to prelink an executable which might
	107	# depend on system libraries. To properly prelink an executable, all
	108	# of its dynamically linked libraries must be prelinked as well. If
	109	# the executable depends on some system libraries, we may not have
	110	# sufficient write priviledges on these files to perform the prelink.
	111	# This is why we make a copy of these shared libraries, and link the
	112	# executable against these copies instead.
	113	#
	114	# Function recognizes only libraries listed by `ldd' after
	115	# its ` => ' separator. That means $INTERP and any libraries not being linked
	116	# with -Wl,-soname,NAME.so are not copied.
	117
	118	proc build_executable_own_libs {testname executable sources options {interp ""} {dir ""}} {
53e981d9	119	global subdir
5e3b36f8	120
6a5f3f43 YQ	121	if { ![isnative] } {
	122	error "This proc can be only used for native target."
	123	}
	124
f302f9e2 AB	125	with_test_prefix "initial build" {
	126	if {[build_executable $testname $executable $sources $options] == -1} {
	127	return ""
	128	}
5e3b36f8	129	}
53e981d9	130	set binfile [standard_output_file ${executable}]
5e3b36f8	131
f61d5529 DE	132	set ldd [gdb_find_ldd]
f61d5529 DE	133	set command "$ldd $binfile"
5e3b36f8 JK	134	set test "ldd $executable"
	135	set result [catch "exec $command" output]
	136	verbose -log "result of $command is $result"
	137	verbose -log "output of $command is $output"
	138	if {$result != 0 \|\| $output == ""} {
	139	fail $test
	140	} else {
	141	pass $test
	142	}
	143
	144	# gdb testsuite will put there also needless -lm.
	145	set test "$test output contains libs"
	146	set libs [regexp -all -inline -line {^.* => (/[^ ]+).*$} $output]
	147	if {[llength $libs] == 0} {
	148	fail $test
	149	} else {
	150	pass $test
	151	}
	152
	153	if {$dir == ""} {
	154	set dir ${binfile}.d
	155	}
	156	file delete -force -- $dir
	157	file mkdir $dir
	158
	159	if {$interp == ""} {
	160	set interp_system [section_get $binfile .interp]
a29a3fb7 GB	161	if {$interp_system == ""} {
	162	fail "$test could not find .interp"
	163	} else {
	164	set interp ${dir}/[file tail $interp_system]
	165	file_copy $interp_system $interp
	166	}
	167	}
	168	if {$interp == "no"} {
	169	set interp ""
5e3b36f8 JK	170	}
	171
	172	set dests {}
	173	foreach {trash abspath} $libs {
	174	set dest "$dir/[file tail $abspath]"
	175	file_copy $abspath $dest
	176	lappend dests $dest
	177	}
	178
	179	# Do not lappend it so that "-rpath $dir" overrides any possible "-rpath"s
	180	# specified by the caller to be able to link it for ldd" above.
a29a3fb7 GB	181	set options [linsert $options 0 "ldflags=-Wl,-rpath,$dir"]
	182	if {$interp != ""} {
	183	set options [linsert $options 0 "ldflags=-Wl,--dynamic-linker,$interp"]
	184	}
5e3b36f8	185
f302f9e2 AB	186	with_test_prefix "rebuild" {
	187	if {[build_executable $testname $executable $sources $options] == -1} {
	188	return ""
	189	}
5e3b36f8 JK	190	}
5e3b36f8 JK	191
a29a3fb7 GB	192	set prelink_args "--ld-library-path=$dir $binfile [concat $dests]"
	193	if {$interp != ""} {
	194	set prelink_args "--dynamic-linker=$interp $prelink_args $interp"
	195	}
5e3b36f8 JK	196	return $prelink_args
	197	}
	198
	199	# Unprelink ARG. Reported test name can be specified by NAME. Return non-zero
	200	# on success, zero on failure.
	201
	202	proc prelink_no {arg {name {}}} {
	203	if {$name == ""} {
	204	set name [file tail $arg]
	205	}
	206	set test "unprelink $name"
	207	set command "exec /usr/sbin/prelink -uN $arg"
	208	verbose -log "command is $command"
	209	set result [catch $command output]
	210	verbose -log "result is $result"
	211	verbose -log "output is $output"
1a219cc7 JK	212	if {$result == 1 && [regexp {^(couldn't execute "/usr/sbin/prelink[^\r\n]": no such file or directory\n?)$} $output]} {
	213	# Without prelink, at least verify that all the binaries do not
	214	# contain the ".gnu.prelink_undo" section (which would mean that they
	215	# have already been prelinked).
	216	set test "$test (missing /usr/sbin/prelink)"
	217	foreach bin [split $arg] {
	218	if [string match "-*" $bin] {
	219	# Skip prelink options.
	220	continue
	221	}
4fa7d390	222	set readelf_program [gdb_find_readelf]
1a219cc7 JK	223	set command "exec $readelf_program -WS $bin"
	224	verbose -log "command is $command"
	225	set result [catch $command output]
	226	verbose -log "result is $result"
	227	verbose -log "output is $output"
	228	if {$result != 0 \|\| [string match {* .gnu.prelink_undo *} $output]} {
	229	fail "$test ($bin is already prelinked)"
	230	return 0
	231	}
	232	}
	233	pass $test
	234	return 1
	235	}
5e3b36f8 JK	236	if {$result == 0 && $output == ""} {
	237	verbose -log "$name has been now unprelinked"
	238	set command "exec /usr/sbin/prelink -uN $arg"
	239	verbose -log "command is $command"
	240	set result [catch $command output]
	241	verbose -log "result is $result"
	242	verbose -log "output is $output"
	243	}
	244	# Last line does miss the trailing \n. There can be multiple such messages
	245	# as ARG may list multiple files.
f61d5529	246	if {$result == 1 && [regexp {^([^\r\n]prelink[^\r\n]: [^ ]* does not have .gnu.prelink_undo section\n?)*$} $output]} {
5e3b36f8 JK	247	pass $test
	248	return 1
	249	} else {
	250	fail $test
	251	return 0
	252	}
	253	}
	254
	255	# Prelink ARG. Reported test name can be specified by NAME. Return non-zero
	256	# on success, zero on failure.
	257
	258	proc prelink_yes {arg {name ""}} {
	259	if {$name == ""} {
	260	set name [file tail $arg]
	261	}
	262
	263	# Try to unprelink it first so that, if it has been already prelinked
	264	# before, we get a different address now, making the new result unaffected
	265	# by any previous prelinking.
1a219cc7 JK	266	if ![prelink_no $arg "$name pre-unprelink"] {
	267	return 0
	268	}
5e3b36f8 JK	269
	270	set test "prelink $name"
	271
	272	# `--no-exec-shield' is for i386, where prelink in the exec-shield mode is
	273	# forced to push all the libraries tight together, in order to fit into
	274	# the first two memory areas (either the ASCII Shield area or at least
	275	# below the executable). If the prelink was performed in exec-shield
	276	# mode, prelink could have no choice on how to randomize the single new
	277	# unprelinked library address without wasting space in the first one/two
	278	# memory areas. In such case prelink could place $ARG repeatedly at the
	279	# same place and we could have false prelink results on
	280	# gdb.base/prelink.exp and others. To prevent this from happening, we use
	281	# the --no-exec-shield switch. This may have some consequences in terms
	282	# of security, but we do not care in our case.
	283
	284	set command "exec /usr/sbin/prelink -qNR --no-exec-shield $arg"
	285
	286	verbose -log "command is $command"
	287	set result [catch $command output]
	288	verbose -log "result is $result"
	289	verbose -log "output is $output"
1a219cc7 JK	290	if {$result == 1 && [regexp {^(couldn't execute "/usr/sbin/prelink[^\r\n]": no such file or directory\n?)$} $output]} {
	291	set test "$test (missing /usr/sbin/prelink)"
	292
	293	# We could not find prelink. We could check whether $args is already
	294	# prelinked but we don't, because:
	295	# - It is unlikely that someone uninstalls prelink after having
	296	# prelinked the system ld.so;
	297	# - We still cannot change its prelinked address.
	298	# Therefore, we just skip the test.
	299
	300	xfail $test
	301	return 0
	302	}
70cc1c23 DE	303	if {$result == 1 && [regexp {DWARF [^\r\n]* unhandled} $output]} {
	304	# Prelink didn't understand the version of dwarf present.
	305	unsupported "$test (dwarf version unhandled)"
	306	return 0
	307	}
5e3b36f8 JK	308	if {$result == 0 && $output == ""} {
	309	pass $test
	310	return 1
	311	} elseif {$result == 1 \
	312	&& [string match -nocase "*: Not enough room to add .dynamic entry" $output]} {
	313	# Linker should have reserved some entries for prelink.
	314	xfail $test
	315	return 0
	316	} else {
	317	fail $test
	318	return 0
	319	}
	320	}