]> git.treefish.org Git - fex.git/blob - bin/fexwall
Original release 20160919
[fex.git] / bin / fexwall
1 #!/usr/bin/perl -w
2
3 # send e-mail to all registered F*EX users
4 #
5 # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
6 #
7
8 use Getopt::Std;
9 use File::Basename;
10 use Cwd 'abs_path';
11
12 # do not run as CGI!
13 exit if $ENV{SCRIPT_NAME};
14
15 unless ($ENV{FEXLIB}) {
16   if ($ENV{FEXHOME}) {
17     $ENV{FEXLIB} = $ENV{FEXHOME}.'/lib';
18   } else {
19     $ENV{FEXLIB} = dirname(dirname(abs_path($0))).'/lib';
20   }
21 }
22 $FEXLIB = $ENV{FEXLIB};
23 die "$0: no FEXLIB\n" unless -f "$FEXLIB/fex.pp";
24
25 # program name
26 $0 =~ s:.*/::;
27
28 # become effective user fex
29 unless ($<) {
30   if (my @pw = getpwnam('fex')) {
31     $)         = $pw[3];
32     $>         = $pw[2];
33     $ENV{HOME} = $pw[7];
34   } else {
35     die "$0: no such user 'fex'\n";
36   }
37 }
38
39 # import from fex.pp
40 our ($FEXHOME,$hostname,$sendmail,$spooldir,$admin,$bcc);
41
42 # load common code, local config : $HOME/lib/fex.ph
43 require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
44
45 die "$0: \$admin not configured in $FEXLIB/fex.ph\n"
46   if not $admin or $admin =~ /example.org/;
47
48 $opt_h = 0;
49
50 getopts('h') or usage(2);
51 usage(0) if $opt_h;
52
53 $subject = "@ARGV";
54 die usage(1) unless $subject;
55
56 local $/;
57 $text = <STDIN>;
58 die usage(1) unless $text;
59
60 if (open my $sig,$ENV{HOME}.'/.signature') {
61   $text .= "\n-- \n" . <$sig>;
62   close $sig;
63 }
64
65 local $/ = "\n";
66
67 chdir $spooldir or die "$0: $spooldir - $!\n";
68
69 # @users = grep { chomp;s:/@:: } glob("*/@");
70 foreach $user (glob("*@*")) {
71   if (-f "$user/@" and (readlink "$user/\@NOTIFICATION"||'') !~ /no/i) {
72     push @users,$user;
73   }
74 }
75
76 foreach $group (glob "*/\@GROUP/*") {
77   if (open $group,$group) {
78     while (<$group>) {
79       s/#.*//;
80       s/:.*\n//;
81       push @users,$_ if /@/;
82     }
83     close $group;
84   }
85 }
86
87 foreach $subuser (glob "*/\@SUBUSER") {
88   if (open $subuser,$subuser) {
89     while (<$subuser>) {
90       s/#.*//;
91       s/:.*\n//;
92       push @users,$_ if /@/;
93     }
94     close $subuser;
95   }
96 }
97
98 # @users = qw'framstag@fex';
99 die "$0: no users found\n" unless @users or grep /@/,@users;
100 push @users,$bcc;
101 @users = uniq(@users);
102
103 open $sendmail,'|-',$sendmail,@users or die "$0: $sendmail - $!\n";
104
105 print {$sendmail}
106   "From: $admin\n",
107   "To: fexusers\@$hostname\n",
108   "Subject: $subject\n",
109   "\n",
110   $text;
111
112 close $sendmail or die "$0: $sendmail - $!\n";
113 print "mail sent to:\n",map { "$_\n" } @users;
114 exit;
115
116 sub uniq {
117   my %x;
118   grep !$x{$_}++,@_;
119 }
120
121 sub usage {
122   print "usage: $0 \"SUBJECT\" < mail.text\n";
123   exit shift||0;
124 }