1#!/usr/perl5/bin/perl -w
2#
3# CDDL HEADER START
4#
5# The contents of this file are subject to the terms of the
6# Common Development and Distribution License (the "License").
7# You may not use this file except in compliance with the License.
8#
9# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
10# or http://www.opensolaris.org/os/licensing.
11# See the License for the specific language governing permissions
12# and limitations under the License.
13#
14# When distributing Covered Code, include this CDDL HEADER in each
15# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
16# If applicable, add the following below this CDDL HEADER, with the
17# fields enclosed by brackets "[]" replaced with your own identifying
18# information: Portions Copyright [yyyy] [name of copyright owner]
19#
20# CDDL HEADER END
21#
22
23#
24# Copyright 2009 Sun Microsystems, Inc.  All rights reserved.
25# Use is subject to license terms.
26#
27#
28
29#
30# Check ELF information.
31#
32# This script descends a directory hierarchy inspecting ELF dynamic executables
33# and shared objects.  The general theme is to verify that common Makefile rules
34# have been used to build these objects.  Typical failures occur when Makefile
35# rules are re-invented rather than being inherited from "cmd/lib" Makefiles.
36#
37# As always, a number of components don't follow the rules, and these are
38# excluded to reduce this scripts output.  Pathnames used for this exclusion
39# assume this script is being run over a "proto" area.  The -a (all) option
40# skips any exclusions.
41#
42# By default any file that has conditions that should be reported is first
43# listed and then each condition follows.  The -o (one-line) option produces a
44# more terse output which is better for sorting/diffing with "nightly".
45#
46# NOTE: missing dependencies, symbols or versions are reported by running the
47# file through ldd(1).  As objects within a proto area are built to exist in a
48# base system, standard use of ldd(1) will bind any objects to dependencies
49# that exist in the base system.  It is frequently the case that newer objects
50# exist in the proto area that are required to satisfy other objects
51# dependencies, and without using these newer objects an ldd(1) will produce
52# misleading error messages.  To compensate for this, the -d option (or the
53# existence of the CODEMSG_WS/ROOT environment variables) cause the creation of
54# alternative dependency mappings via crle(1) configuration files that establish
55# any proto shared objects as alternatives to their base system location.  Thus
56# ldd(1) can be executed against these configuration files so that objects in a
57# proto area bind to their dependencies in the same proto area.
58
59
60# Define all global variables (required for strict)
61use vars  qw($SkipDirs $SkipFiles $SkipTextrelFiles $SkipDirectBindFiles);
62use vars  qw($SkipUndefFiles $SkipUnusedDirs);
63use vars  qw($SkipStabFiles $SkipNoExStkFiles $SkipCrleConf);
64use vars  qw($SkipUnusedSearchPath $SkipUnrefObject);
65use vars  qw($Prog $Mach $Isalist $Env $Ena64 $Tmpdir $Error $Gnuc);
66use vars  qw($UnusedPaths $LddNoU $Crle32 $Crle64 $Conf32 $Conf64);
67use vars  qw($SkipDirectBindDirs $SkipInterps $SkipSymSort $OldDeps %opt);
68
69use strict;
70
71
72# Define any directories we should skip completely.
73$SkipDirs = qr{
74	usr/lib/devfsadm |		# 4382889
75	usr/lib/libc |			# optimized libc
76	usr/lib/rcm |			# 4426119
77	usr/perl5 |			# alan's taking care of these :-)
78	usr/src				# no need to look at shipped source
79}x;
80
81# Define any files we should skip completely.
82$SkipFiles = qr{ ^(?:
83	lddstub |			# lddstub has no dependencies
84	geniconvtbl\.so |		# 4384329
85	libssagent\.so\.1 |		# 4328854
86	libpsvcplugin_psr\.so\.1 |	# 4385799
87	libpsvcpolicy_psr\.so\.1 |	#  "  "
88	libpsvcpolicy\.so\.1 |		#  "  "
89	picl_slm\.so |			#  "  "
90	mod_ipp\.so |			# Apache loadable module
91	fptest |	# USIII specific extns. cause ldd noise on USII bld. m/c
92	grub
93	)$
94}x;
95
96# Define any files that are allowed text relocations.
97$SkipTextrelFiles = qr{ ^(?:
98	unix |				# kernel models are non-pic
99	mdb				# relocations against __RTC (dbx)
100	)$
101}x;
102
103# Define any directories or files that are allowed to have no direct bound
104# symbols
105$SkipDirectBindDirs = qr{
106	usr/ucb
107}x;
108
109$SkipDirectBindFiles = qr{ ^(?:
110	unix |
111	sbcp |
112	libproc.so.1 |
113	libnisdb.so.2
114	)$
115}x;
116
117# Define any files that are allowed undefined references.
118
119$SkipUndefFiles = qr{ ^(?:
120	libsvm\.so\.1 |			# libspmicommon.so.1 lacking
121	libnisdb\.so\.2			# C++
122	)$
123}x;
124
125# Define any files that have unused dependencies.
126$SkipUnusedDirs = qr{
127	lib/picl/plugins/ |		# require devtree dependencies
128	/lib/libp			# profile libc makes libm an unused
129}x;					#	dependency of standard libc
130
131# Define any files that should contain debugging information.
132$SkipStabFiles = qr{ ^(?:
133	unix
134	)$
135}x;
136
137# Define any files that don't require a non-executable stack definition.
138$SkipNoExStkFiles = qr{ ^(?:
139	forth |
140	unix |
141	multiboot
142	)$
143}x;
144
145# Identify any files that should be skipped when building a crle(1)
146# configuration file.  As the hwcap libraries can be loop-back mounted onto
147# libc, these can confuse crle(1) because of their identical dev/inode.
148$SkipCrleConf = qr{
149	lib/libc/libc_hwcap
150}x;
151
152# Skip "unused search path=" ldd(1) diagnostics.
153$SkipUnusedSearchPath = qr{
154	/usr/lib/fs/autofs.*\ from\ .automountd |		# dlopen()
155	/etc/ppp/plugins.*\ from\ .*pppd |			# dlopen()
156	/usr/lib/inet/ppp.*\ from\ .*pppd |			# dlopen()
157	/usr/sfw/lib.*\ from\ .*libipsecutil.so.1 |		# dlopen()
158	/usr/platform/.*rsmlib.*\ from\ .*librsm.so.2 |		# dlopen()
159	\$ORIGIN.*\ from\ .*fcode.so |				# dlopen()
160	/opt/VRTSvxvm/lib.*\ from\ .*libdiskmgt\.so\.1 |	# dlopen()
161	/usr/platform/.*\ from\ .*/usr/platform |		# picl
162	/usr/lib/picl/.*\ from\ .*/usr/platform |		# picl
163	/usr/platform/.*\ from\ .*/usr/lib/picl |		# picl
164	/usr/lib/smbsrv.*\ from\ .*libsmb\.so\.1 |		# future needs
165	/usr/lib/mps/secv1.*\ from\ .*libnss3\.so |		# non-OSNet
166	/usr/lib/mps.*\ from\ .*libnss3\.so |			# non-OSNet
167	/usr/sfw/lib.*\ from\ .*libdbus-1\.so\.3 |		# non-OSNet
168	/usr/sfw/lib.*\ from\ .*libdbus-glib-1\.so\.2 |		# non-OSNet
169	/usr/sfw/lib.*\ from\ .*libglib-2\.0\.so\.0 |		# non-OSNet
170	/usr/X11/lib.*\ from\ .*libglib-2\.0\.so\.0 |		# non-OSNet
171	/usr/sfw/lib.*\ from\ .*libgobject-2\.0\.so\.0 |	# non-OSNet
172	/usr/X11/lib.*\ from\ .*libgobject-2\.0\.so\.0 |	# non-OSNet
173	/usr/sfw/lib.*\ from\ .*libcrypto\.so\.0\.9\.8 |	# non-OSNet
174	/usr/sfw/lib.*\ from\ .*libnetsnmp\.so\.5 |		# non-OSNet
175	/usr/sfw/lib.*\ from\ .*libgcc_s\.so\.1 |		# non-OSNet
176	/usr.*\ from\ .*tst\.gcc\.exe |				# gcc built
177	/usr/postgres/8.3/lib.*\ from\ .*libpq\.so\.5 |		# non-OSNET
178	/usr/sfw/lib.*\ from\ .*libpq\.so\.5			# non-OSNET
179}x;
180
181# Skip "unreferenced object=" ldd(1) diagnostics.
182$SkipUnrefObject = qr{
183	/libmapmalloc\.so\.1;\ unused\ dependency\ of |		# interposer
184	/libstdc\+\+\.so\.6;\ unused\ dependency\ of |		# gcc build
185	/libm\.so\.2.*\ of\ .*libstdc\+\+\.so\.6 |		# gcc build
186	/lib.*\ of\ .*/lib/picl/plugins/ |			# picl
187	/lib.*\ of\ .*libcimapi\.so |				# non-OSNET
188	/lib.*\ of\ .*libjvm\.so |				# non-OSNET
189	/lib.*\ of\ .*libnetsnmp\.so\.5 |			# non-OSNET
190	/lib.*\ of\ .*libnetsnmpagent\.so\.5 |			# non-OSNET
191	/lib.*\ of\ .*libnetsnmpmibs\.so\.5 |			# non-OSNET
192	/lib.*\ of\ .*libnetsnmphelpers\.so\.5 |		# non-OSNET
193	/lib.*\ of\ .*libnspr4\.so |				# non-OSNET
194	/lib.*\ of\ .*libsoftokn3\.so |				# non-OSNET
195	/lib.*\ of\ .*libspmicommon\.so\.1 |			# non-OSNET
196	/lib.*\ of\ .*libspmocommon\.so\.1 |			# non-OSNET
197	/lib.*\ of\ .*libssl3\.so |				# non-OSNET
198	/lib.*\ of\ .*libxml2\.so\.2 |				# non-OSNET
199	/lib.*\ of\ .*libxslt\.so\.1 |				# non-OSNET
200	/lib.*\ of\ .*libpq\.so\.4 				# non-OSNET
201}x;
202
203# Define any files that should only have unused (ldd -u) processing.
204$UnusedPaths = qr{
205	ucb/shutdown			# libucb interposes on libc and makes
206					# dependencies on libc seem unnecessary
207}x;
208
209# Define interpreters we should ignore.
210$SkipInterps = qr{
211	misc/krtld |
212	misc/amd64/krtld |
213	misc/sparcv9/krtld
214}x;
215
216# Catch libintl and libw, although ld(1) will bind to these and thus determine
217# they're needed, their content was moved into libc as of on297 build 7.
218# libthread and libpthread were completely moved into libc as of on10 build 53.
219# libdl was moved into libc as of on10 build 49.  librt and libaio were moved
220# into libc as of Nevada build 44.
221$OldDeps = qr{ ^(?:
222	libintl\.so\.1 |
223	libw\.so\.1 |
224	libthread\.so\.1 |
225	libpthread\.so\.1 |
226	libdl\.so\.1 |
227	librt\.so\.1 |
228	libaio\.so\.1
229	)$
230}x;
231
232# Files for which we skip checking of duplicate addresses in the
233# symbol sort sections. Such exceptions should be rare --- most code will
234# not have duplicate addresses, since it takes assember or a "#pragma weak"
235# to do such aliasing in C. C++ is different: The compiler generates aliases
236# for implementation reasons, and the mangled names used to encode argument
237# and return value types are difficult to handle well in mapfiles.
238# Furthermore, the Sun compiler and gcc use different and incompatible
239# name mangling conventions. Since ON must be buildable by either, we
240# would have to maintain two sets of mapfiles for each such object.
241# C++ use is rare in ON, so this is not worth pursuing.
242#
243$SkipSymSort = qr{ ^.*(?:
244	opt/SUNWdtrt/tst/common/pid/tst.weak2.exe |	# DTrace test
245	lib/amd64/libnsl\.so\.1 |			# C++
246	lib/sparcv9/libnsl\.so\.1 |			# C++
247	lib/sparcv9/libfru\.so\.1 |			# C++
248	usr/lib/sgml/nsgmls |				# C++
249	ld\.so\.1 |					# libc_pic.a user
250	lib/libsun_fc\.so\.1 |				# C++
251	lib/amd64/libsun_fc\.so\.1 |			# C++
252	lib/sparcv9/libsun_fc\.so\.1 			# C++
253	)$
254}x;
255
256use Getopt::Std;
257
258# -----------------------------------------------------------------------------
259
260# Reliably compare two OS revisions.  Arguments are <ver1> <op> <ver2>.
261# <op> is the string form of a normal numeric comparison operator.
262sub cmp_os_ver {
263	my @ver1 = split(/\./, $_[0]);
264	my $op = $_[1];
265	my @ver2 = split(/\./, $_[2]);
266
267	push @ver2, ("0") x $#ver1 - $#ver2;
268	push @ver1, ("0") x $#ver2 - $#ver1;
269
270	my $diff = 0;
271	while (@ver1 || @ver2) {
272		if (($diff = shift(@ver1) - shift(@ver2)) != 0) {
273			last;
274		}
275	}
276	return (eval "$diff $op 0" ? 1 : 0);
277}
278
279# This script relies on ldd returning output reflecting only the binary
280# contents.  But if LD_PRELOAD* environment variables are present, libraries
281# named by them will also appear in the output, disrupting our analysis.
282# So, before we get too far, scrub the environment.
283
284delete($ENV{LD_PRELOAD});
285delete($ENV{LD_PRELOAD_32});
286delete($ENV{LD_PRELOAD_64});
287
288# Establish a program name for any error diagnostics.
289chomp($Prog = `basename $0`);
290
291# Determine what machinery is available.
292$Mach = `uname -p`;
293$Isalist = `isalist`;
294$Env = "";
295if ($Mach =~ /sparc/) {
296	if ($Isalist =~ /sparcv9/) {
297		$Ena64 = "ok";
298	}
299} elsif ($Mach =~ /i386/) {
300	if ($Isalist =~ /amd64/) {
301		$Ena64 = "ok";
302	}
303}
304
305# Check that we have arguments.
306if ((getopts('ad:imosv', \%opt) == 0) || ($#ARGV == -1)) {
307	print "usage: $Prog [-a] [-d depdir] [-m] [-o] [-s] file | dir, ...\n";
308	print "\t[-a]\t\tprocess all files (ignore any exception lists)\n";
309	print "\t[-d dir]\testablish dependencies from under directory\n";
310	print "\t[-i]\t\tproduce dynamic table entry information\n";
311	print "\t[-m]\t\tprocess mcs(1) comments\n";
312	print "\t[-o]\t\tproduce one-liner output (prefixed with pathname)\n";
313	print "\t[-s]\t\tprocess .stab and .symtab entries\n";
314	print "\t[-v]\t\tprocess version definition entries\n";
315	exit 1;
316} else {
317	my($Proto);
318
319	if ($opt{d}) {
320		# User specified dependency directory - make sure it exists.
321		if (! -d $opt{d}) {
322			print "$Prog: $opt{d} is not a directory\n";
323			exit 1;
324		}
325		$Proto = $opt{d};
326
327	} elsif ($ENV{CODEMGR_WS}) {
328		my($Root);
329
330		# Without a user specified dependency directory see if we're
331		# part of a codemanager workspace and if a proto area exists.
332		if (($Root = $ENV{ROOT}) && (-d $Root)) {
333			$Proto = $Root;
334		}
335	}
336
337	if (!($Tmpdir = $ENV{TMPDIR}) || (! -d $Tmpdir)) {
338		$Tmpdir = "/tmp";
339	}
340
341	# Determine whether this is a __GNUC build.  If so, unused search path
342	# processing is disabled.
343	if (defined $ENV{__GNUC}) {
344		$Gnuc = 1;
345	} else {
346		$Gnuc = 0;
347	}
348
349	# Look for dependencies under $Proto.
350	if ($Proto) {
351		# To support alternative dependency mapping we'll need ldd(1)'s
352		# -e option.  This is relatively new (s81_30), so make sure
353		# ldd(1) is capable before gathering any dependency information.
354		if (system('ldd -e /usr/lib/lddstub 2> /dev/null')) {
355			print "ldd: does not support -e, unable to ";
356			print "create alternative dependency mappingings.\n";
357			print "ldd: option added under 4390308 (s81_30).\n\n";
358		} else {
359			# Gather dependencies and construct a alternative
360			# dependency mapping via a crle(1) configuration file.
361			GetDeps($Proto, "/");
362			GenConf();
363		}
364	}
365
366	# To support unreferenced dependency detection we'll need ldd(1)'s -U
367	# option.  This is relatively new (4638070), and if not available we
368	# can still fall back to -u.  Even with this option, don't use -U with
369	# releases prior to 5.10 as the cleanup for -U use only got integrated
370	# into 5.10 under 4642023.  Note, that nightly doesn't typically set a
371	# RELEASE from the standard <env> files.  Users who wish to disable use
372	# of ldd(1)'s -U should set (or uncomment) RELEASE in their <env> file
373	# if using nightly, or otherwise establish it in their environment.
374	if (system('ldd -U /usr/lib/lddstub 2> /dev/null')) {
375		$LddNoU = 1;
376	} else {
377		my($Release);
378
379		if (($Release = $ENV{RELEASE}) &&
380		    (cmp_os_ver($Release, "<", "5.10"))) {
381			$LddNoU = 1;
382		} else {
383			$LddNoU = 0;
384		}
385	}
386
387	# For each argument determine if we're dealing with a file or directory.
388	foreach my $Arg (@ARGV) {
389		# Ignore symbolic links.
390		if (-l $Arg) {
391			next;
392		}
393
394		if (!stat($Arg)) {
395			next;
396		}
397
398		# Process simple files.
399		if (-f _) {
400			my($RelPath) = $Arg;
401			my($File) = $Arg;
402			my($Secure) = 0;
403
404			$RelPath =~ s!^.*/!./!;
405			$File =~ s!^.*/!!;
406
407			if (-u _ || -g _) {
408				$Secure = 1;
409			}
410
411			ProcFile($Arg, $RelPath, $File, $Secure);
412			next;
413		}
414		# Process directories.
415		if (-d _) {
416			ProcDir($Arg, ".");
417			next;
418		}
419
420		print "$Arg is not a file or directory\n";
421		$Error = 1;
422	}
423
424	# Cleanup
425	CleanUp();
426}
427
428$Error = 0;
429
430# Clean up any temporary files.
431sub CleanUp {
432	if ($Crle64) {
433		unlink $Crle64;
434	}
435	if ($Conf64) {
436		unlink $Conf64;
437	}
438	if ($Crle32) {
439		unlink $Crle32;
440	}
441	if ($Conf32) {
442		unlink $Conf32;
443	}
444}
445
446# Create an output message, either a one-liner (under -o) or preceded by the
447# files relative pathname as a title.
448sub OutMsg {
449	my($Ttl, $Path, $Msg) = @_;
450
451	if ($opt{o}) {
452		$Msg =~ s/^[ \t]*//;
453		print "$Path: $Msg\n";
454	} else {
455		if ($Ttl eq 0) {
456			print "==== $Path ====\n";
457		}
458		print "$Msg\n";
459	}
460}
461
462# Determine whether this a ELF dynamic object and if so investigate its runtime
463# attributes.
464sub ProcFile {
465	my($FullPath, $RelPath, $File, $Secure) = @_;
466	my(@Elf, @Ldd, $Dyn, $Intp, $Dll, $Ttl, $Sym, $Interp, $Stack);
467	my($Sun, $Relsz, $Pltsz, $Tex, $Stab, $Strip, $Lddopt, $SymSort);
468	my($Val, $Header, $SkipLdd, $IsX86, $RWX, $UnDep);
469	my($HasDirectBinding, $HasVerdef);
470
471	# Ignore symbolic links.
472	if (-l $FullPath) {
473		return;
474	}
475
476	$Ttl = 0;
477	@Ldd = 0;
478
479	# Determine whether we have access to inspect the file.
480	if (!(-r $FullPath)) {
481		OutMsg($Ttl++, $RelPath,
482		    "\tunable to inspect file: permission denied");
483		return;
484	}
485
486	# Determine if this is a file we don't care about.
487	if (!$opt{a}) {
488		if ($File =~ $SkipFiles) {
489			return;
490		}
491	}
492
493	# Determine whether we have a executable (static or dynamic) or a
494	# shared object.
495	@Elf = split(/\n/, `elfdump -epdicyv $FullPath 2>&1`);
496
497	$Dyn = $Intp = $Dll = $Stack = $IsX86 = $RWX = 0;
498	$Interp = 1;
499	$Header = 'None';
500	foreach my $Line (@Elf) {
501		# If we have an invalid file type (which we can tell from the
502		# first line), or we're processing an archive, bail.
503		if ($Header eq 'None') {
504			if (($Line =~ /invalid file/) ||
505			    ($Line =~ /$FullPath(.*):/)) {
506				return;
507			}
508		}
509
510		if ($Line =~ /^ELF Header/) {
511			$Header = 'Ehdr';
512
513		} elsif ($Line =~ /^Program Header/) {
514			$Header = 'Phdr';
515			$RWX = 0;
516
517		} elsif ($Line =~ /^Interpreter/) {
518			$Header = 'Intp';
519
520		} elsif ($Line =~ /^Dynamic Section/) {
521			# A dynamic section indicates we're a dynamic object
522			# (this makes sure we don't check static executables).
523			$Dyn = 1;
524
525		} elsif (($Header eq 'Ehdr') && ($Line =~ /e_type:/)) {
526			# The e_type field indicates whether this file is a
527			# shared object (ET_DYN) or an executable (ET_EXEC).
528			if ($Line =~ /ET_DYN/) {
529				$Dll = 1;
530			} elsif ($Line !~ /ET_EXEC/) {
531				return;
532			}
533		} elsif (($Header eq 'Ehdr') && ($Line =~ /ei_class:/)) {
534			# If we encounter a 64-bit object, but we're not running
535			# on a 64-bit system, suppress calling ldd(1).
536			if (($Line =~ /ELFCLASS64/) && !$Ena64) {
537				$SkipLdd = 1;
538			}
539		} elsif (($Header eq 'Ehdr') && ($Line =~ /e_machine:/)) {
540			# If it's a X86 object, we need to enforce RW- data.
541			if (($Line =~ /(EM_AMD64|EM_386)/)) {
542				$IsX86 = 1;
543			}
544		} elsif (($Header eq 'Phdr') &&
545		    ($Line =~ /\[ PF_X  PF_W  PF_R \]/)) {
546			# RWX segment seen.
547			$RWX = 1;
548
549		} elsif (($Header eq 'Phdr') &&
550		    ($Line =~ /\[ PT_LOAD \]/ && $RWX && $IsX86)) {
551			# Seen an RWX PT_LOAD segment.
552			if ($File !~ $SkipNoExStkFiles) {
553				OutMsg($Ttl++, $RelPath,
554				    "\tapplication requires non-executable " .
555				    "data\t<no -Mmapfile_noexdata?>");
556			}
557
558		} elsif (($Header eq 'Phdr') &&
559		    ($Line =~ /\[ PT_SUNWSTACK \]/)) {
560			# This object defines a non-executable stack.
561			$Stack = 1;
562
563		} elsif (($Header eq 'Intp') && !$opt{a} &&
564		    ($Line =~ $SkipInterps)) {
565			# This object defines an interpretor we should skip.
566			$Interp = 0;
567		}
568	}
569
570	# Determine whether this ELF executable or shared object has a
571	# conforming mcs(1) comment section.  If the correct $(POST_PROCESS)
572	# macros are used, only a 3 or 4 line .comment section should exist
573	# containing one or two "@(#)SunOS" identifying comments (one comment
574	# for a non-debug build, and two for a debug build). The results of
575	# the following split should be three or four lines, the last empty
576	# line being discarded by the split.
577	if ($opt{m}) {
578		my(@Mcs, $Con, $Dev);
579
580		@Mcs = split(/\n/, `mcs -p $FullPath 2>&1`);
581
582		$Con = $Dev = $Val = 0;
583		foreach my $Line (@Mcs) {
584			$Val++;
585
586			if (($Val == 3) && ($Line !~ /^@\(#\)SunOS/)) {
587				$Con = 1;
588				last;
589			}
590			if (($Val == 4) && ($Line =~ /^@\(#\)SunOS/)) {
591				$Dev = 1;
592				next;
593			}
594			if (($Dev == 0) && ($Val == 4)) {
595				$Con = 1;
596				last;
597			}
598			if (($Dev == 1) && ($Val == 5)) {
599				$Con = 1;
600				last;
601			}
602		}
603		if ($opt{m} && ($Con == 1)) {
604			OutMsg($Ttl++, $RelPath,
605			    "\tnon-conforming mcs(1) comment\t<no \$(POST_PROCESS)?>");
606		}
607	}
608
609	# Applications should contain a non-executable stack definition.
610	if (($Dll == 0) && ($Stack == 0)) {
611		if (!$opt{a}) {
612			if ($File =~ $SkipNoExStkFiles) {
613				goto DYN;
614			}
615		}
616		OutMsg($Ttl++, $RelPath,
617		    "\tapplication requires non-executable stack\t<no -Mmapfile_noexstk?>");
618	}
619
620DYN:
621	# Having caught any static executables in the mcs(1) check and non-
622	# executable stack definition check, continue with dynamic objects
623	# from now on.
624	if ($Dyn eq 0) {
625		return;
626	}
627
628	# Only use ldd unless we've encountered an interpreter that should
629	# be skipped.
630	if (!$SkipLdd && $Interp) {
631		my $LDDFullPath = $FullPath;
632
633		if ($Secure) {
634			# The execution of a secure application over an nfs file
635			# system mounted nosuid will result in warning messages
636			# being sent to /var/adm/messages.  As this type of
637			# environment can occur with root builds, move the file
638			# being investigated to a safe place first.  In addition
639			# remove its secure permission so that it can be
640			# influenced by any alternative dependency mappings.
641
642			my($TmpPath) = "$Tmpdir/$File";
643
644			system('cp', $LDDFullPath, $TmpPath);
645			chmod 0777, $TmpPath;
646			$LDDFullPath = $TmpPath;
647		}
648
649		# Use ldd(1) to determine the objects relocatability and use.
650		# By default look for all unreferenced dependencies.  However,
651		# some objects have legitimate dependencies that they do not
652		# reference.
653		if ($LddNoU || ($RelPath =~ $UnusedPaths)) {
654			$Lddopt = "-ru";
655		} else {
656			$Lddopt = "-rU";
657		}
658		@Ldd = split(/\n/, `ldd $Lddopt $Env $LDDFullPath 2>&1`);
659		if ($Secure) {
660			unlink $LDDFullPath;
661		}
662	}
663
664	$Val = 0;
665	$Sym = 5;
666	$UnDep = 1;
667
668	foreach my $Line (@Ldd) {
669
670		if ($Val == 0) {
671			$Val = 1;
672			# Make sure ldd(1) worked.  One possible failure is that
673			# this is an old ldd(1) prior to -e addition (4390308).
674			if ($Line =~ /usage:/) {
675				$Line =~ s/$/\t<old ldd(1)?>/;
676				OutMsg($Ttl++, $RelPath, $Line);
677				last;
678			} elsif ($Line =~ /execution failed/) {
679				OutMsg($Ttl++, $RelPath, $Line);
680				last;
681			}
682
683			# It's possible this binary can't be executed, ie. we've
684			# found a sparc binary while running on an intel system,
685			# or a sparcv9 binary on a sparcv7/8 system.
686			if ($Line =~ /wrong class/) {
687				OutMsg($Ttl++, $RelPath,
688				    "\thas wrong class or data encoding");
689				next;
690			}
691
692			# Historically, ldd(1) likes executable objects to have
693			# their execute bit set.  Note that this test isn't
694			# applied unless the -a option is in effect, as any
695			# non-executable files are skipped by default to reduce
696			# the cost of running this script.
697			if ($Line =~ /not executable/) {
698				OutMsg($Ttl++, $RelPath,
699				    "\tis not executable");
700				next;
701			}
702		}
703
704		# Look for "file" or "versions" that aren't found.  Note that
705		# these lines will occur before we find any symbol referencing
706		# errors.
707		if (($Sym == 5) && ($Line =~ /not found\)/)) {
708			if ($Line =~ /file not found\)/) {
709				$Line =~ s/$/\t<no -zdefs?>/;
710			}
711			OutMsg($Ttl++, $RelPath, $Line);
712			next;
713		}
714		# Look for relocations whose symbols can't be found.  Note, we
715		# only print out the first 5 relocations for any file as this
716		# output can be excessive.
717		if ($Sym && ($Line =~ /symbol not found/)) {
718			# Determine if this file is allowed undefined
719			# references.
720			if ($Sym == 5) {
721				if (!$opt{a}) {
722					if ($File =~ $SkipUndefFiles) {
723						$Sym = 0;
724						next;
725					}
726				}
727			}
728			if ($Sym-- == 1) {
729				if (!$opt{o}) {
730					OutMsg($Ttl++, $RelPath,
731					    "\tcontinued ...");
732				}
733				next;
734			}
735			# Just print the symbol name.
736			$Line =~ s/$/\t<no -zdefs?>/;
737			OutMsg($Ttl++, $RelPath, $Line);
738			next;
739		}
740		# Look for any unused search paths.
741		if ($Line =~ /unused search path=/) {
742			# Note, skip this comparison for __GNUC builds, as the
743			# gnu compilers insert numerous unused search paths.
744			if ($Gnuc == 1) {
745				next;
746			}
747			if (!$opt{a}) {
748				if ($Line =~ $SkipUnusedSearchPath) {
749					next;
750				}
751			}
752			if ($Secure) {
753				$Line =~ s!$Tmpdir/!!;
754			}
755			$Line =~ s/^[ \t]*(.*)/\t$1\t<remove search path?>/;
756			OutMsg($Ttl++, $RelPath, $Line);
757			next;
758		}
759		# Look for unreferenced dependencies.  Note, if any unreferenced
760		# objects are ignored, then set $UnDep so as to suppress any
761		# associated unused-object messages.
762		if ($Line =~ /unreferenced object=/) {
763			if (!$opt{a}) {
764				if ($Line =~ $SkipUnrefObject) {
765					$UnDep = 0;
766					next;
767				}
768			}
769			if ($Secure) {
770				$Line =~ s!$Tmpdir/!!;
771			}
772			$Line =~ s/^[ \t]*(.*)/\t$1\t<remove lib or -zignore?>/;
773			OutMsg($Ttl++, $RelPath, $Line);
774			next;
775		}
776		# Look for any unused dependencies.
777		if ($UnDep && ($Line =~ /unused/)) {
778			if (!$opt{a}) {
779				if ($RelPath =~ $SkipUnusedDirs) {
780					$UnDep = 0;
781					next;
782				}
783			}
784			if ($Secure) {
785				$Line =~ s!$Tmpdir/!!;
786			}
787			$Line =~ s/^[ \t]*(.*)/\t$1\t<remove lib or -zignore?>/;
788			OutMsg($Ttl++, $RelPath, $Line);
789			next;
790		}
791	}
792
793	# Reuse the elfdump(1) data to investigate additional dynamic linking
794	# information.
795
796	$Sun = $Relsz = $Pltsz = $Dyn = $Stab = $SymSort = 0;
797	$Tex = $Strip = 1;
798	$HasDirectBinding = 0;
799	$HasVerdef = 0;
800
801	$Header = 'None';
802ELF:	foreach my $Line (@Elf) {
803		# We're only interested in the section headers and the dynamic
804		# section.
805		if ($Line =~ /^Section Header/) {
806			$Header = 'Shdr';
807
808			if (($Sun == 0) && ($Line =~ /\.SUNW_reloc/)) {
809				# This object has a combined relocation section.
810				$Sun = 1;
811
812			} elsif (($Stab == 0) && ($Line =~ /\.stab/)) {
813				# This object contain .stabs sections
814				$Stab = 1;
815			} elsif (($SymSort == 0) &&
816				 ($Line =~ /\.SUNW_dyn(sym)|(tls)sort/)) {
817				# This object contains a symbol sort section
818				$SymSort = 1;
819			}
820
821			if (($Strip == 1) && ($Line =~ /\.symtab/)) {
822				# This object contains a complete symbol table.
823				$Strip = 0;
824			}
825			next;
826
827		} elsif ($Line =~ /^Dynamic Section/) {
828			$Header = 'Dyn';
829			next;
830		} elsif ($Line =~ /^Syminfo Section/) {
831			$Header = 'Syminfo';
832			next;
833		} elsif ($Line =~ /^Version Definition Section/) {
834			$HasVerdef = 1;
835			next;
836		} elsif (($Header ne 'Dyn') && ($Header ne 'Syminfo')) {
837			next;
838		}
839
840		# Look into the Syminfo section.
841		# Does this object have at least one Directly Bound symbol?
842		if (($Header eq 'Syminfo')) {
843			my(@Symword);
844
845			if ($HasDirectBinding == 1) {
846				next;
847			}
848
849			@Symword = split(' ', $Line);
850
851			if (!defined($Symword[1])) {
852				next;
853			}
854			if ($Symword[1] =~ /B/) {
855				$HasDirectBinding = 1;
856			}
857			next;
858		}
859
860		# Does this object contain text relocations.
861		if ($Tex && ($Line =~ /TEXTREL/)) {
862			# Determine if this file is allowed text relocations.
863			if (!$opt{a}) {
864				if ($File =~ $SkipTextrelFiles) {
865					$Tex = 0;
866					next ELF;
867				}
868			}
869			OutMsg($Ttl++, $RelPath,
870			    "\tTEXTREL .dynamic tag\t\t\t<no -Kpic?>");
871			$Tex = 0;
872			next;
873		}
874
875		# Does this file have any relocation sections (there are a few
876		# psr libraries with no relocations at all, thus a .SUNW_reloc
877		# section won't exist either).
878		if (($Relsz == 0) && ($Line =~ / RELA?SZ/)) {
879			$Relsz = hex((split(' ', $Line))[2]);
880			next;
881		}
882
883		# Does this file have any plt relocations.  If the plt size is
884		# equivalent to the total relocation size then we don't have
885		# any relocations suitable for combining into a .SUNW_reloc
886		# section.
887		if (($Pltsz == 0) && ($Line =~ / PLTRELSZ/)) {
888			$Pltsz = hex((split(' ', $Line))[2]);
889			next;
890		}
891
892		# Does this object have any dependencies.
893		if ($Line =~ /NEEDED/) {
894			my($Need) = (split(' ', $Line))[3];
895
896			if ($Need =~ $OldDeps) {
897				# Catch any old (unnecessary) dependencies.
898				OutMsg($Ttl++, $RelPath,
899				    "\tNEEDED=$Need\t<dependency no longer necessary>");
900			} elsif ($opt{i}) {
901				# Under the -i (information) option print out
902				# any useful dynamic entries.
903				OutMsg($Ttl++, $RelPath, "\tNEEDED=$Need");
904			}
905			next;
906		}
907
908		# Is this object built with -B direct flag on?
909		if ($Line =~ / DIRECT /) {
910			$HasDirectBinding = 1;
911		}
912
913		# Does this object specify a runpath.
914		if ($opt{i} && ($Line =~ /RPATH/)) {
915			my($Rpath) = (split(' ', $Line))[3];
916			OutMsg($Ttl++, $RelPath, "\tRPATH=$Rpath");
917			next;
918		}
919	}
920
921	# A shared object, that contains non-plt relocations, should have a
922	# combined relocation section indicating it was built with -z combreloc.
923	if ($Dll && $Relsz && ($Relsz != $Pltsz) && ($Sun == 0)) {
924		OutMsg($Ttl++, $RelPath,
925		    "\tSUNW_reloc section missing\t\t<no -zcombreloc?>");
926	}
927
928	# No objects released to a customer should have any .stabs sections
929	# remaining, they should be stripped.
930	if ($opt{s} && $Stab) {
931		if (!$opt{a}) {
932			if ($File =~ $SkipStabFiles) {
933				goto DONESTAB;
934			}
935		}
936		OutMsg($Ttl++, $RelPath,
937		    "\tdebugging sections should be deleted\t<no strip -x?>");
938	}
939
940	# Identify an object that is not built with either -B direct or
941	# -z direct.
942	if (($RelPath =~ $SkipDirectBindDirs) ||
943	    ($File =~ $SkipDirectBindFiles)) {
944		goto DONESTAB;
945	}
946	if ($Relsz && ($HasDirectBinding == 0)) {
947		OutMsg($Ttl++, $RelPath,
948		    "\tobject has no direct bindings\t<no -B direct or -z direct?>");
949	}
950
951DONESTAB:
952
953	# All objects should have a full symbol table to provide complete
954	# debugging stack traces.
955	if ($Strip) {
956		OutMsg($Ttl++, $RelPath,
957		    "\tsymbol table should not be stripped\t<remove -s?>");
958	}
959
960	# If there are symbol sort sections in this object, report on
961	# any that have duplicate addresses.
962	ProcSymSort($FullPath, $RelPath, \$Ttl) if $SymSort;
963
964	# If -v was specified, and the object has a version definition
965	# section, generate output showing each public symbol and the
966	# version it belongs to.
967	ProcVerdef($FullPath, $RelPath, \$Ttl) if $HasVerdef && $opt{v};
968}
969
970
971## ProcSymSortOutMsg(RefTtl, RelPath, secname, addr, names...)
972#
973# Call OutMsg for a duplicate address error in a symbol sort
974# section
975#
976sub ProcSymSortOutMsg {
977	my($RefTtl, $RelPath, $secname, $addr, @names) = @_;
978
979	OutMsg($$RefTtl++, $RelPath,
980	    "$secname: duplicate $addr: ". join(', ', @names));
981}
982
983
984## ProcSymSort(FullPath, RelPath)
985#
986# Examine the symbol sort sections for the given object and report
987# on any duplicate addresses found.  Ideally, mapfile directives
988# should be used when building objects that have multiple symbols
989# with the same address so that only one of them appears in the sort
990# section. This saves space, reduces user confusion, and ensures that
991# libproc and debuggers always display public names instead of symbols
992# that are merely implementation details.
993#
994sub ProcSymSort {
995
996	my($FullPath, $RelPath, $RefTtl) = @_;
997
998	# If this object is exempt from checking, return quietly
999	return if ($FullPath =~ $SkipSymSort);
1000
1001
1002	open(SORT, "elfdump -S $FullPath|") ||
1003	    die "$Prog: Unable to execute elfdump (symbol sort sections)\n";
1004
1005	my $line;
1006	my $last_addr;
1007	my @dups = ();
1008	my $secname;
1009	while ($line = <SORT>) {
1010		chomp $line;
1011
1012		next if ($line eq '');
1013
1014		# If this is a header line, pick up the section name
1015		if ($line =~ /^Symbol Sort Section:\s+([^\s]+)\s+/) {
1016			$secname = $1;
1017
1018			# Every new section is followed by a column header line
1019			$line = <SORT>;		# Toss header line
1020
1021			# Flush anything left from previous section
1022			ProcSymSortOutMsg($RefTtl, $RelPath, $secname,
1023			    $last_addr, @dups) if (scalar(@dups) > 1);
1024
1025			# Reset variables for new sort section
1026			$last_addr = '';
1027			@dups = ();
1028
1029			next;
1030		}
1031
1032		# Process symbol line
1033		my @fields = split /\s+/, $line;
1034		my $new_addr = $fields[2];
1035		my $new_type = $fields[8];
1036		my $new_name = $fields[9];
1037
1038		if ($new_type eq 'UNDEF') {
1039		    OutMsg($RefTtl++, $RelPath,
1040		        "$secname: unexpected UNDEF symbol " .
1041			"(link-editor error): $new_name");
1042		    next;
1043		}
1044
1045		if ($new_addr eq $last_addr) {
1046			push @dups, $new_name;
1047		} else {
1048			ProcSymSortOutMsg($RefTtl, $RelPath, $secname,
1049			    $last_addr, @dups) if (scalar(@dups) > 1);
1050			@dups = ( $new_name );
1051			$last_addr = $new_addr;
1052		}
1053	}
1054
1055	ProcSymSortOutMsg($RefTtl, $RelPath, $secname, $last_addr, @dups)
1056		if (scalar(@dups) > 1);
1057
1058	close SORT;
1059}
1060
1061
1062## ProcVerdef(FullPath, RelPath)
1063#
1064# Examine the version definition section for the given object and report
1065# each public symbol along with the version it belongs to.
1066#
1067sub ProcVerdef {
1068
1069	my($FullPath, $RelPath, $RefTtl) = @_;
1070	my $line;
1071	my $cur_ver = '';
1072	my $tab = $opt{o} ? '' : "\t";
1073
1074	# pvs -dov provides information about the versioning hierarchy
1075	# in the file. Lines are of the format:
1076	#	path - version[XXX];
1077	# where [XXX] indicates optional information, such as flags
1078	# or inherited versions.
1079	#
1080	# Private versions are allowed to change freely, so ignore them.
1081	open(PVS, "pvs -dov $FullPath|") ||
1082	    die "$Prog: Unable to execute pvs (version definition section)\n";
1083
1084	while ($line = <PVS>) {
1085		chomp $line;
1086
1087		if ($line =~ /^[^\s]+\s+-\s+([^;]+)/) {
1088			my $ver = $1;
1089
1090			next if $ver =~ /private/i;
1091			OutMsg($$RefTtl++, $RelPath, "${tab}VERDEF=$ver");
1092		}
1093	}
1094	close PVS;
1095
1096	# pvs -dos lists the symbols assigned to each version definition.
1097	# Lines are of the format:
1098	#	path - version: symbol;
1099	#	path - version: symbol (size);
1100	# where the (size) is added to data items, but not for functions.
1101	# We strip off the size, if present.
1102
1103	open(PVS, "pvs -dos $FullPath|") ||
1104	    die "$Prog: Unable to execute pvs (version definition section)\n";
1105	while ($line = <PVS>) {
1106		chomp $line;
1107		if ($line =~ /^[^\s]+\s+-\s+([^:]+):\s*([^\s;]+)/) {
1108		    my $ver = $1;
1109		    my $sym = $2;
1110
1111		    next if $ver =~ /private/i;
1112
1113		    if ($opt{o}) {
1114			OutMsg($$RefTtl++, $RelPath,
1115			       "VERSION=$ver, SYMBOL=$sym");
1116		    } else {
1117			if ($cur_ver ne $ver) {
1118			    OutMsg($$RefTtl++, $RelPath, "\tVERSION=$ver");
1119			    $cur_ver = $ver;
1120			}
1121			OutMsg($$RefTtl++, $RelPath, "\t\tSYMBOL=$sym");
1122		    }
1123		}
1124	}
1125
1126	close PVS;
1127}
1128
1129
1130sub ProcDir {
1131	my($FullDir, $RelDir) = @_;
1132	my($NewFull, $NewRel);
1133
1134	# Determine if this is a directory we don't care about.
1135	if (!$opt{a}) {
1136		if ($RelDir =~ $SkipDirs) {
1137			return;
1138		}
1139	}
1140
1141	# Open the directory and read each entry, omit files starting with "."
1142	if (opendir(DIR, $FullDir)) {
1143		foreach my $Entry (readdir(DIR)) {
1144			if ($Entry =~ /^\./) {
1145				next;
1146			}
1147			$NewFull = "$FullDir/$Entry";
1148
1149			# Ignore symlinks.
1150			if (-l $NewFull) {
1151				next;
1152			}
1153			if (!stat($NewFull)) {
1154				next;
1155			}
1156			$NewRel = "$RelDir/$Entry";
1157
1158			# Descend into and process any directories.
1159			if (-d _) {
1160				ProcDir($NewFull, $NewRel);
1161				next;
1162			}
1163
1164			# Typically dynamic objects are executable, so we can
1165			# reduce the overall cost of this script (a lot!) by
1166			# screening out non-executables here, rather than pass
1167			# them to file(1) later.  However, it has been known
1168			# for shared objects to be mistakenly left non-
1169			# executable, so with -a let all files through so that
1170			# this requirement can be verified (see ProcFile()).
1171			if (!$opt{a}) {
1172				if (! -x _) {
1173					next;
1174				}
1175			}
1176
1177			# Process any standard files.
1178			if (-f _) {
1179				my($Secure) = 0;
1180
1181				if (-u _ || -g _) {
1182					$Secure = 1;
1183				}
1184
1185				ProcFile($NewFull, $NewRel, $Entry, $Secure);
1186				next;
1187			}
1188
1189		}
1190		closedir(DIR);
1191	}
1192}
1193
1194# Create a crle(1) script for any 64-bit dependencies we locate.  A runtime
1195# configuration file will be generated to establish alternative dependency
1196# mappings for all these dependencies.
1197
1198sub Entercrle64 {
1199	my($FullDir, $RelDir, $Entry) = @_;
1200
1201	if (!$Crle64) {
1202		# Create and initialize the script if is doesn't already exit.
1203
1204		$Crle64 = "$Tmpdir/$Prog.crle64.$$";
1205		open(CRLE64, "> $Crle64") ||
1206			die "$Prog: open failed: $Crle64: $!";
1207
1208		print CRLE64 "#!/bin/sh\ncrle -64\\\n";
1209	}
1210	print CRLE64 "\t-o $FullDir -a $RelDir/$Entry \\\n";
1211}
1212
1213# Create a crle(1) script for any 32-bit dependencies we locate.  A runtime
1214# configuration file will be generated to establish alternative dependency
1215# mappings for all these dependencies.
1216
1217sub Entercrle32 {
1218	my($FullDir, $RelDir, $Entry) = @_;
1219
1220	if (!$Crle32) {
1221		# Create and initialize the script if is doesn't already exit.
1222
1223		$Crle32 = "$Tmpdir/$Prog.crle32.$$";
1224		open(CRLE32, "> $Crle32") ||
1225			die "$Prog: open failed: $Crle32: $!";
1226
1227		print CRLE32 "#!/bin/sh\ncrle \\\n";
1228	}
1229	print CRLE32 "\t-o $FullDir -a $RelDir/$Entry \\\n";
1230}
1231
1232# Having finished gathering dependencies, complete any crle(1) scripts and
1233# execute them to generate the associated runtime configuration files.  In
1234# addition establish the environment variable required to pass the configuration
1235# files to ldd(1).
1236
1237sub GenConf {
1238	if ($Crle64) {
1239		$Conf64 = "$Tmpdir/$Prog.conf64.$$";
1240		print CRLE64 "\t-c $Conf64\n";
1241
1242		chmod 0755, $Crle64;
1243		close CRLE64;
1244
1245		if (system($Crle64)) {
1246			undef $Conf64;
1247		}
1248	}
1249	if ($Crle32) {
1250		$Conf32 = "$Tmpdir/$Prog.conf32.$$";
1251		print CRLE32 "\t-c $Conf32\n";
1252
1253		chmod 0755, $Crle32;
1254		close CRLE32;
1255
1256		if (system($Crle32)) {
1257			undef $Conf32;
1258		}
1259	}
1260
1261	if ($Crle64 && $Conf64 && $Crle32 && $Conf32) {
1262		$Env = "-e LD_FLAGS=config_64=$Conf64,config_32=$Conf32";
1263	} elsif ($Crle64 && $Conf64) {
1264		$Env = "-e LD_FLAGS=config_64=$Conf64";
1265	} elsif ($Crle32 && $Conf32) {
1266		$Env = "-e LD_FLAGS=config_32=$Conf32";
1267	}
1268}
1269
1270# Recurse through a directory hierarchy looking for appropriate dependencies.
1271
1272sub GetDeps {
1273	my($FullDir, $RelDir) = @_;
1274	my($NewFull);
1275
1276	# Open the directory and read each entry, omit files starting with "."
1277	if (opendir(DIR, $FullDir)) {
1278		 foreach my $Entry (readdir(DIR)) {
1279			if ($Entry =~ /^\./) {
1280				next;
1281			}
1282			$NewFull = "$FullDir/$Entry";
1283
1284			# We need to follow links so that any dependencies
1285			# are expressed in all their available forms.
1286			# Bail on symlinks like 32 -> .
1287			if (-l $NewFull) {
1288				if (readlink($NewFull) =~ /^\.$/) {
1289					next;
1290				}
1291			}
1292			if (!stat($NewFull)) {
1293				next;
1294			}
1295
1296			if (!$opt{a}) {
1297				if ($NewFull =~ $SkipCrleConf) {
1298					next;
1299				}
1300			}
1301
1302			# If this is a directory descend into it.
1303			if (-d _) {
1304				my($NewRel);
1305
1306				if ($RelDir =~ /^\/$/) {
1307					$NewRel = "$RelDir$Entry";
1308				} else {
1309					$NewRel = "$RelDir/$Entry";
1310				}
1311
1312				GetDeps($NewFull, $NewRel);
1313				next;
1314			}
1315
1316			# If this is a regular file determine if its a
1317			# valid ELF dependency.
1318			if (-f _) {
1319				my($File);
1320
1321				# Typically shared object dependencies end with
1322				# ".so" or ".so.?", hence we can reduce the cost
1323				# of this script (a lot!) by screening out files
1324				# that don't follow this pattern.
1325				if (!$opt{a}) {
1326					if ($Entry !~ /\.so(?:\.\d+)*$/) {
1327						next;
1328					}
1329				}
1330
1331				$File = `file $NewFull`;
1332				if ($File !~ /dynamic lib/) {
1333					next;
1334				}
1335
1336				if ($File =~ /32-bit/) {
1337					Entercrle32($FullDir, $RelDir, $Entry);
1338				} elsif ($Ena64) {
1339					Entercrle64($FullDir, $RelDir, $Entry);
1340				}
1341				next;
1342			}
1343		}
1344		closedir(DIR);
1345	}
1346}
1347exit $Error
1348