summaryrefslogtreecommitdiff
path: root/Master/tlpkg/bin/tl-check-wrapper-consistency
blob: 3db1f5e576b8c4e6135acd0abf336a32a953c4b4 (plain)
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
#!/usr/bin/env perl
# $Id$
# Public domain.  Originally written 2008.
# 
# Check that the same set of files are wrappers on windows
# and symlinks on all others.

BEGIN {
  $^W = 1;
  ($mydir = $0) =~ s,/[^/]*$,,;
  unshift (@INC, "$mydir/..");
  chomp ($Master = `cd $mydir/../.. && pwd`);
}

use Getopt::Long;
use Pod::Usage;

our ($mydir, $Master);

my $help = 0;
GetOptions("help|?"       => \$help) or pod2usage(1);
pod2usage(-exitstatus => 0, -verbose => 2) if $help;

exit (&main ());


sub main {
  my $err = 0;
  
  my $bindir = "$Master/bin";
  chdir ($bindir) || die "chdir($bindir) failed: $!";
  
  # get entries from one Unix platform, assuming they're the same everywhere.
  my %w = &unx_wrapper_entries ("x86_64-linux");

  my $windows_dir = "windows";
  $cww = "windows/runscript.exe";
  $err += &check_w32 ($windows_dir, $cww, %w);

  return $err;
}



# return all symlinks starting with ".." in DIR as a hash, with symlink
# targets as the values.  Check that targets are executable.
# 
sub unx_wrapper_entries {
  my ($DIR) = @_;
  my %ret;
  
  chomp (my $olddir = `pwd`);
  chdir ($DIR) || die "chdir($DIR) failed: $!";

  local *DIR;
  opendir (DIR, ".") || die "opendir($DIR) failed: $!";
  while (my $ent = readdir (DIR)) {
    next unless -l $ent;  # skip all but symlinks
    next if -d $ent;      # and skip directories (i.e., man/)

    my $target = readlink ($ent);
    die "readlink($ent) failed: $!" if !defined ($target);
    next unless $target =~ /^\.\./;  # skip all but .. symlinks
    
    # skip {context,mtxrun}.lua:
    next if $ent =~ /\.lua$/;

    # the target of the symlink should otherwise be executable.
    warn "$ent: target $target not executable\n" if ! -x $target;

    $ret{$ent} = $target;  # remember name and link target
  }
  closedir (DIR) || warn "closedir($DIR) failed: $!";
  chdir ($olddir) || die "chdir($olddir) failed: $!";

  return %ret;
}



# Windows is painfully special. Given the list of wrappers in UW, check
# that each of those entries (excluding shell scripts and other spceial
# cases) exists in W32DIR as a .exe, and furthermore is a copy of the
# canonical w32 wrapper exe specified in W32CANONICAL.
# 
# (2023: our windows binaries aren't 32-bit any more, but don't bother
# renaming.)
# 
sub check_w32 {
  my ($w32dir, $w32canonical, %uw) = @_;
  my $diff = 0;
  
  my %is_shell_script = &list_shell_scripts ();
  for my $k (sort keys %uw) {
    next if $is_shell_script{$k};    # skip shell scripts
    #
    # also skip these special cases:
    next if $k =~
      /^(epspdftk|latexindent|mktex.*|texdoctk|tlcockpit|tlmgr|tlshell|xasy)$/;
    #
    # else do the diff with the canonical wrapper:
    $diff += system ("cmp $w32dir/$k.exe $w32canonical");
  }

  opendir (DIR, $w32dir) || die "opendir($DIR) failed: $!";
  my @binfiles = readdir (DIR);
  closedir (DIR) || warn "closedir($DIR) failed: $!";

  foreach my $f (@binfiles) {
    next unless ($f =~ s/\.(bat|cmd)$//); # only batch files
    next if $uw{$f};                      # already checked
    $diff += system ("cmp $w32dir/$f.exe $w32canonical");
  }

  # extra check for fmtutil-sys.exe, since fmtutil is an executable.
  $diff += system ("cmp $w32dir/fmtutil-sys.exe $w32canonical");
  
  return $diff;
}

# As it happens, we already distinguish sh scripts from others in the
# build process, for basically the same reason.  So return the list
# maintained there by using a target defined in linked_scripts/Makefie
# for us.
# 
sub list_shell_scripts {
  my %sh;
  
  # has to be the Work/ directory to get the Makefile, not Makefile.{in,am}.
  my $Work = "$Master/../Build/source/Work";
  my $Work_linked_scripts = "$Work/texk/texlive/linked_scripts";
  
  -d "$Work_linked_scripts"||die "no linked_scripts dir: $Work_linked_scripts";
  
  # use make; ensure we get only the last line, although that should be
  # all there is.
  my $lst = `make -s -C $Work_linked_scripts echo-shell-scripts | tail -1`;
  
  for my $script (split (" ", $lst)) {
    $script =~ s,^.*/,,;
    $sh{$script} = 1;  # save with extension (for listings-ext.sh)
    #
    $script =~ s,\.[^.]*$,,;
    $sh{$script} = 1;  # save without extension (everything else)
  }

  # more shell scripts, that are not part of linked_scripts.
  $sh{"chkweb"} = 1;
  
  return %sh;
}