| 1 | #!/usr/bin/perl |
| 2 | eval "exec perl -S $0 $*" |
| 3 | if $running_under_some_shell; |
| 4 | |
| 5 | # $Id: kitpost.SH 1 2006-08-24 12:32:52Z rmanfredi $ |
| 6 | # |
| 7 | # Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi |
| 8 | # |
| 9 | # You may redistribute only under the terms of the Artistic Licence, |
| 10 | # as specified in the README file that comes with the distribution. |
| 11 | # You may reuse parts of this distribution only within the terms of |
| 12 | # that same Artistic Licence; a copy of which may be found at the root |
| 13 | # of the source tree for dist 4.0. |
| 14 | # |
| 15 | # $Log: kitpost.SH,v $ |
| 16 | # Revision 3.0.1.2 1994/10/29 15:48:26 ram |
| 17 | # patch36: don't use rootid as a variable, it is known by metaconfig |
| 18 | # |
| 19 | # Revision 3.0.1.1 1994/05/06 13:54:53 ram |
| 20 | # patch23: created |
| 21 | # |
| 22 | |
| 23 | $inews='inews'; |
| 24 | $mailer='/usr/sbin/sendmail'; |
| 25 | $orgname='PROCURA B.V.'; |
| 26 | $version = '3.5'; |
| 27 | $patchlevel = '0'; |
| 28 | |
| 29 | $progname = &profile; # Read ~/.dist_profile |
| 30 | require 'getopts.pl'; |
| 31 | &usage unless $#ARGV >= 0; |
| 32 | &usage unless &Getopts("hrVm:D:H:"); |
| 33 | |
| 34 | if ($opt_V) { |
| 35 | print STDERR "$progname $version PL$patchlevel\n"; |
| 36 | exit 0; |
| 37 | } elsif ($opt_h) { |
| 38 | &usage; |
| 39 | } |
| 40 | |
| 41 | $RCSEXT = ',v' unless $RCSEXT; |
| 42 | if ($inews eq 'inews') { |
| 43 | $inews = '/usr/lib/news/inews' if -f '/usr/lib/news/inews'; |
| 44 | } |
| 45 | |
| 46 | chdir '..' if -d '../bugs'; |
| 47 | |
| 48 | &readpackage; |
| 49 | |
| 50 | $orgname = &tilda_expand($orgname); |
| 51 | chop($orgname = `cat $orgname`) if $orgname =~ m|^/|; |
| 52 | |
| 53 | if ($opt_r) { |
| 54 | $repost = ' (REPOST)'; |
| 55 | } |
| 56 | |
| 57 | while ($_ = shift) { |
| 58 | if (/^(kit)?[1-9][\d\-]*$/) { |
| 59 | s/^kit//; |
| 60 | push(@argv,$_); |
| 61 | } else { |
| 62 | push(@ngroups,$_); |
| 63 | } |
| 64 | } |
| 65 | $ngroups = join(',',@ngroups) unless $#ngroups < 0; |
| 66 | $dest = $opt_m; |
| 67 | &usage unless $ngroups || $dest; |
| 68 | |
| 69 | @ARGV = @argv; |
| 70 | |
| 71 | if (-f "$package.kit10") { |
| 72 | @filelist = <$package.kit[0-9][0-9]>; |
| 73 | } |
| 74 | else { |
| 75 | @filelist = <$package.kit[0-9]>; |
| 76 | } |
| 77 | pop(@filelist) =~ /(\d+)$/ && ($maxnum = $1 + 0); |
| 78 | |
| 79 | if ($#ARGV < 0) { |
| 80 | $argv = "1-$maxnum"; |
| 81 | @ARGV = $argv; |
| 82 | } |
| 83 | |
| 84 | $argv = &rangeargs(@ARGV); |
| 85 | @ARGV = split(' ', $argv); |
| 86 | |
| 87 | $argv =~ s/ $//; |
| 88 | |
| 89 | if ($#ARGV < 0) { |
| 90 | print STDERR "$progname: no kits specified.\n"; |
| 91 | &usage; |
| 92 | } else { |
| 93 | local($s) = $#ARGV ? 's' : ''; |
| 94 | print "$progname: posting $package $baserev kit$s $argv to $ngroups...\n" |
| 95 | if $ngroups; |
| 96 | print "$progname: mailing $package $baserev kit$s $argv to $dest...\n" |
| 97 | if $dest; |
| 98 | } |
| 99 | |
| 100 | $desc = "$opt_D, " if $opt_D; |
| 101 | |
| 102 | fork && exit; |
| 103 | |
| 104 | # Compute a suitable root message ID that all parts will reference, so that |
| 105 | # threaded news readers will correctly process them. |
| 106 | # Unfortunately, this works only when all kits are sent. |
| 107 | ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = |
| 108 | localtime(time); |
| 109 | $mon++; |
| 110 | $rootmid = "$year$mon$mday$hour$min$sec.AA$$"; |
| 111 | $first = $maxnum >= 10 ? "01" : "1"; |
| 112 | $rootmsgid = "<$rootmid.P$first.$maintloc>"; |
| 113 | |
| 114 | until ($#ARGV < 0) { |
| 115 | $kitnum = shift; |
| 116 | $kitnum = "0$kitnum" if $kitnum < 10 && $maxnum >= 10; |
| 117 | open(FILE, "$package.kit$kitnum") || |
| 118 | die "$progname: can't open $package.kit$kitnum: $!\n"; |
| 119 | if ($ngroups) { |
| 120 | open(INEWS,"|$inews -h") || die "$progname: can't fork $inews: $!\n"; |
| 121 | } |
| 122 | if ($dest) { |
| 123 | $opt = '-odq' if $mailer =~ /sendmail/; |
| 124 | $dest =~ s/,/ /g; |
| 125 | ($to = $dest) =~ s/\s+/, /g; |
| 126 | open(MAILER,"|$mailer $opt $dest") || |
| 127 | die "$progname: can't fork $mailer: $!\n"; |
| 128 | } |
| 129 | |
| 130 | $msg_id = "<$rootmid.P$kitnum.$maintloc>"; |
| 131 | $msg_id = $rootmsgid if $kitnum == 1; |
| 132 | $msg_id .= "\nReferences: $rootmsgid" if $kitnum != 1; |
| 133 | |
| 134 | print INEWS "Newsgroups: $ngroups\n"; |
| 135 | print MAILER "To: $to\n"; |
| 136 | $head = <<EOH; |
| 137 | Subject: $package $baserev - ${desc}part$kitnum/$maxnum$repost |
| 138 | Message-ID: $msg_id |
| 139 | Organization: $orgname |
| 140 | |
| 141 | Submitted-by: $maintname <$maintloc> |
| 142 | Archive-name: $package-$baserev/part$kitnum |
| 143 | Environment: UNIX |
| 144 | |
| 145 | EOH |
| 146 | print INEWS $head; |
| 147 | print MAILER $head; |
| 148 | |
| 149 | if ($kitnum == 1 && $opt_H) { |
| 150 | open(HEAD, $opt_H) || warn "$progname: can't open $opt_H: $!\n"; |
| 151 | while (<HEAD>) { |
| 152 | print INEWS; |
| 153 | print MAILER; |
| 154 | } |
| 155 | close HEAD; |
| 156 | } |
| 157 | |
| 158 | while (<FILE>) { |
| 159 | print INEWS; |
| 160 | print MAILER; |
| 161 | } |
| 162 | close FILE; |
| 163 | close INEWS; |
| 164 | die "$progname: could not post part$kitnum.\n" if $ngroups && $?; |
| 165 | close MAILER; |
| 166 | die "$progname: could not send part$kitnum.\n" if $dest && $?; |
| 167 | } |
| 168 | |
| 169 | sub usage { |
| 170 | print STDERR <<EOM; |
| 171 | Usage: $progname [-hrV] [-H file] [-D desc] [-m dest1,dest2] [kits] [newsgroups] |
| 172 | -h : print this message and exit |
| 173 | -m : set-up recipients for (additional) mailing |
| 174 | -r : signals a repost |
| 175 | -D : specify description string for subject line |
| 176 | -H : specify file to be used as header for first part |
| 177 | -V : print version number and exit |
| 178 | EOM |
| 179 | exit 1; |
| 180 | } |
| 181 | |
| 182 | sub rangeargs { |
| 183 | local($result) = ''; |
| 184 | local($min,$max,$_); |
| 185 | while ($#_ >= 0) { |
| 186 | $_ = shift(@_); |
| 187 | while (/^\s*\d/) { |
| 188 | s/^\s*(\d+)//; |
| 189 | $min = $1; |
| 190 | if (s/^,//) { |
| 191 | $max = $min; |
| 192 | } |
| 193 | elsif (s/^-(\d*)//) { |
| 194 | $max = $1; |
| 195 | if ($max == 0 && $maxnum) { |
| 196 | $max = $maxnum; |
| 197 | } |
| 198 | s/^[^,],?//; |
| 199 | } |
| 200 | else { |
| 201 | $max = $min; |
| 202 | } |
| 203 | for ($i = $min; $i <= $max; ++$i) { |
| 204 | $result .= $i . ' '; |
| 205 | } |
| 206 | } |
| 207 | } |
| 208 | $result; |
| 209 | } |
| 210 | |
| 211 | sub readpackage { |
| 212 | if (! -f '.package') { |
| 213 | if ( |
| 214 | -f '../.package' || |
| 215 | -f '../../.package' || |
| 216 | -f '../../../.package' || |
| 217 | -f '../../../../.package' |
| 218 | ) { |
| 219 | die "Run in top level directory only.\n"; |
| 220 | } else { |
| 221 | die "No .package file! Run packinit.\n"; |
| 222 | } |
| 223 | } |
| 224 | open(PACKAGE,'.package'); |
| 225 | while (<PACKAGE>) { |
| 226 | next if /^:/; |
| 227 | next if /^#/; |
| 228 | if (($var,$val) = /^\s*(\w+)=(.*)/) { |
| 229 | $val = "\"$val\"" unless $val =~ /^['"]/; |
| 230 | eval "\$$var = $val;"; |
| 231 | } |
| 232 | } |
| 233 | close PACKAGE; |
| 234 | } |
| 235 | |
| 236 | # Perform ~name expansion ala ksh... |
| 237 | # (banish csh from your vocabulary ;-) |
| 238 | sub tilda_expand { |
| 239 | local($path) = @_; |
| 240 | return $path unless $path =~ /^~/; |
| 241 | $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e; # ~name |
| 242 | $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e; # ~ |
| 243 | $path; |
| 244 | } |
| 245 | |
| 246 | # Set up profile components into %Profile, add any profile-supplied options |
| 247 | # into @ARGV and return the command invocation name. |
| 248 | sub profile { |
| 249 | local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile'); |
| 250 | local($me) = $0; # Command name |
| 251 | $me =~ s|.*/(.*)|$1|; # Keep only base name |
| 252 | return $me unless -s $profile; |
| 253 | local(*PROFILE); # Local file descriptor |
| 254 | local($options) = ''; # Options we get back from profile |
| 255 | unless (open(PROFILE, $profile)) { |
| 256 | warn "$me: cannot open $profile: $!\n"; |
| 257 | return; |
| 258 | } |
| 259 | local($_); |
| 260 | local($component); |
| 261 | while (<PROFILE>) { |
| 262 | next if /^\s*#/; # Skip comments |
| 263 | next unless /^$me/o; |
| 264 | if (s/^$me://o) { # progname: options |
| 265 | chop; |
| 266 | $options .= $_; # Merge options if more than one line |
| 267 | } |
| 268 | elsif (s/^$me-([^:]+)://o) { # progname-component: value |
| 269 | $component = $1; |
| 270 | chop; |
| 271 | s/^\s+//; # Trim leading and trailing spaces |
| 272 | s/\s+$//; |
| 273 | $Profile{$component} = $_; |
| 274 | } |
| 275 | } |
| 276 | close PROFILE; |
| 277 | return unless $options; |
| 278 | require 'shellwords.pl'; |
| 279 | local(@opts); |
| 280 | eval '@opts = &shellwords($options)'; # Protect against mismatched quotes |
| 281 | unshift(@ARGV, @opts); |
| 282 | return $me; # Return our invocation name |
| 283 | } |
| 284 | |