r8366: Root-level files don't have a slash, but acls need to be settable on
[kai/samba-autobuild/.git] / examples / mklogon / mklogon.pl
1 #!/usr/bin/perl -w
2
3 # 05/01/2005 - 18:07:10
4 #
5 # mklogon.pl - Login Script Generator
6 # Copyright (C) 2005 Ricky Nance
7 # ricky.nance@gmail.com
8 # http://www.weaubleau.k12.mo.us/~rnance/samba/mklogon.txt
9 #
10 # This program is free software; you can redistribute it and/or
11 # modify it under the terms of the GNU General Public License
12 # as published by the Free Software Foundation; either version 2
13 # of the License, or any later version.
14 #
15 # This program is distributed in the hope that it will be useful,
16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 # GNU General Public License for more details.
19 #
20 # You should have received a copy of the GNU General Public License
21 # along with this program; if not, write to the Free Software
22 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
23 #
24
25 # Version: 1.1 Beta
26 # Revised: 06/28/2005
27
28 # Comments...
29 # Working on logging to the system logs, Logs user activity, but not errors yet.
30
31 use strict;
32 use Getopt::Long;
33
34 eval { require Config::Simple; };
35 if ($@) {
36     print("\n");
37     print( "It appears as though you don't have the Config Simple perl module installed.\n" );
38     print("The package is typically called 'Config::Simple' \n");
39     print("and it needs to be installed, before you can use this utility\n");
40     print("Most PERL installations will allow you to use a command like\n");
41     print("\ncpan -i Config::Simple\n");
42     print("from the command line while logged in as the root user.\n");
43     print("\n");
44     exit(1);
45 }
46
47 # use Data::Dumper; #Used for debugging purposes
48
49 # This variable should point to the external conf file, personally I would set
50 # it to /etc/samba/mklogon.conf
51 my $configfile;
52
53 foreach my $dir ( ( '/etc', '/etc/samba', '/usr/local/samba/lib' ) ) {
54     if ( -e "$dir/mklogon.conf" ) {
55         $configfile = "$dir/mklogon.conf";
56         last;
57     }
58 }
59
60 # This section will come directly from the samba server. Basically it just makes the script easier to read.
61 my $getopts = GetOptions(
62     'u|username=s'   => \my $user,
63     'm|machine=s'    => \my $machine,
64     's|servername=s' => \my $server,
65     'o|ostype=s'     => \my $os,
66     'i|ip=s'         => \my $ip,
67     'd|date=s'       => \my $smbdate,
68     'h|help|?'       => \my $help
69 );
70
71 if ($help) {
72     help();
73     exit(0);
74 }
75
76 # We want the program to error out if its missing an argument.
77 if ( !defined($user) )    { error("username"); }
78 if ( !defined($machine) ) { error("machine name") }
79 if ( !defined($server) )  { error("server name") }
80 if ( !defined($os) )      { error("operating system") }
81 if ( !defined($ip) )      { error("ip address") }
82 if ( !defined($smbdate) ) { error("date") }
83
84 # This section will be read from the external config file
85 my $cfg = new Config::Simple($configfile) or die "Could not find $configfile";
86
87 # Read this part from the samba config
88 my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time);
89 my $sambaconf = $cfg->param("global.sambaconf") or die "Couldn't find your samba config! \n";
90 my $smbcfg = new Config::Simple( filename => $sambaconf, syntax => "ini" );
91 my $smbprof = $smbcfg->param("profiles.path");
92 my $smbnetlogdir = $smbcfg->param("netlogon.path");
93 my $logging      = lc( $cfg->param("global.logging") );
94 my $mkprofile    = lc( $cfg->param("global.mkprofile") );
95 my $logdir       = $cfg->param("global.logdir");
96 my $logfile      = $cfg->param("global.logfile");
97 my $logs         = "$logdir\/$logfile";
98 my $logtype      = $cfg->param("global.logtype");
99 my $usermap      = "usermap.$user";
100 my $osmap        = "os.$os";
101 my @ostype       = $cfg->param($osmap);
102 my @username     = $cfg->param($usermap);
103 my $compname     = $cfg->param( -block => "machines" );
104 my $ipname       = $cfg->param( -block => "ip" );
105 my $timesync     = $cfg->param("global.timesync");
106 my $altserver    = $cfg->param("global.servername");
107 if ( defined($altserver) ) { $server = $altserver; }
108 $server = uc($server);
109
110 # Lets start logging stuff if it is turned on in the config
111 if ( $logging =~ m/on|yes|1/i ) {
112     if ($logtype =~ m/file/i) {
113         print "----- Logging is turned on in the config. -----\n";
114         print "----- Location of the logfile is \"$logs\" -----\n";
115         open LOG, ">>$logs";
116         printf LOG "Date: $smbdate Time: ";
117         printf LOG '%02d', $hour;
118         print LOG ":";
119         printf LOG '%02d', $min;
120         print LOG ".";
121         printf LOG '%02d', $sec;
122         print LOG " -- User: $user - Machine: $machine - IP: $ip -- \n";
123         close(LOG);
124     } elsif ($logtype =~ m/syslog|system/i){
125         use Sys::Syslog;
126         my $alert = "User: $user Logged into $machine ($ip) at $hour:$min.$sec on $smbdate.";
127         openlog($0, 'cons', 'user');
128         syslog('alert', $alert);
129         closelog();
130
131     }
132 } else {
133     print "----- Logging is turned off in the config. -----\n";
134 }
135
136 # If the user wants to make profiles with this script lets go
137 if ( defined($smbprof) ) {
138     if ( $mkprofile =~ m/on|yes|1/i ) {
139         print "----- Automatic making of user profiles is turned on in the config. ----- \n";
140         ( my $login, my $pass, my $uid, my $gid ) = getpwnam($user)
141           or die "$user not in passwd file \n";
142         $smbprof =~ s/\%U/$user/g;
143         my $dir2 = "$smbprof\/$user";
144         print "$smbprof \n";
145         print "$dir2 \n";
146         if ( !-e $dir2 ) {
147             print "Creating " . $user . "'s profile \n";
148             mkdir $smbprof;
149             mkdir $dir2;
150             chomp($user);
151             chown $uid, $gid, $smbprof;
152             chown $uid, $gid, $dir2;
153         } else {
154             print $user . "'s profile already exists \n";
155         }
156     } else {
157         print "----- Automatic making of user profiles is turned off in the config. ----- \n";
158     }
159 }
160
161 # Lets start making the batch files.
162 open LOGON, ">$smbnetlogdir\/$user.bat" or die "Unable to create userfile $smbnetlogdir\/$user.bat";
163 print LOGON "\@ECHO OFF \r\n";
164
165 if ( $timesync =~ m/on|yes|1/i ) {
166     print LOGON "NET TIME /SET /YES \\\\$server \r\n";
167 } else {
168     print "----- Time syncing to the client is turned off in the config. -----\n";
169 }
170
171 # Mapping from the common section
172 my $common = $cfg->param( -block => "common" );
173 for my $key ( keys %$common ) {
174     drive_map( @{ $common->{$key} } );
175 }
176
177 # Map shares on a per user basis.
178 drive_map(@username);
179
180 # Map shares based on the Operating System.
181 drive_map(@ostype);
182
183 # Map shares only if they are in a group
184 # This line checks against the unix "groups" command, to see the secondary groups of a user.
185 my @usergroups = split( /\s/, do { open my $groups, "-|", groups => $user; <$groups> } );
186 foreach (@usergroups) {
187     my $groupmap  = "groupmap.$_";
188     my @groupname = $cfg->param($groupmap);
189     drive_map(@groupname);
190 }
191
192 #Here is where we check the machine name against the config...
193 for my $key ( keys %$compname ) {
194     my $test = $compname->{$key};
195     if ( ref $test eq 'ARRAY' ) {
196         foreach (@$test) {
197             if ( $_ eq $machine ) {
198                 my $preformit = $cfg->param("preformcommands.$key");
199                 if ( defined($preformit) ) {
200                     if ( ref $preformit ) {
201                         foreach (@$preformit) { print LOGON "$_ \r\n"; }
202                     } else {
203                         print LOGON "$preformit \r\n";
204                     }
205                 }
206             }
207         }
208     }
209     elsif ( $test eq $machine ) {
210         my $preformit = $cfg->param("preformcommands.$key");
211         if ( defined($preformit) ) {
212             if ( ref $preformit ) {
213                 foreach (@$preformit) { print LOGON "$_ \r\n"; }
214             } else {
215                 print LOGON "$preformit \r\n";
216             }
217         }
218     }
219 }
220
221 # Here is where we test the ip address against the client to see if they have "Special Mapping"
222 my $val;
223 for my $key ( sort keys %$ipname ) {
224     if ( ref $ipname->{$key} eq 'ARRAY' ) {
225         foreach ( @{ $ipname->{$key} } ) {
226             getipval( $_, $key );
227         }
228     } else {
229         getipval( $ipname->{$key}, $key );
230     }
231 }
232
233 sub getipval {
234     my ( $range, $rangename ) = @_;
235     if ( parse( $ip, ipmap($range) ) ) {
236         if ( $val eq 'true' ) {
237             my $preformit = $cfg->param("preformcommands.$rangename");
238             if ( defined($preformit) ) {
239                 if ( ref $preformit ) {
240                     foreach (@$preformit) { print LOGON "$_ \r\n"; }
241                 } else {
242                     print LOGON "$preformit \r\n";
243                 }
244             }
245         } elsif ( $val eq 'false' ) {
246         }
247     } else {
248     }
249 }
250
251 sub ipmap {
252     my $pattern = shift;
253     my ( $iprange, $iprange2, $ipmask );
254     if ( $pattern =~ m/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\/(\d{1,2})$/ ) {
255         # 1.1.1.1/3 notation
256         $iprange = pack( "U4", $1, $2, $3, $4 );
257         $ipmask = pack( "U4", 0, 0, 0, 0 );
258         my $numbits = $5;
259         for ( my $i = 0 ; $i < $numbits ; $i++ ) {
260             vec( $ipmask, int( $i / 8 ) * 8 + ( 8 - ( $i % 8 ) ) - 1, 1 ) = 1;
261         }
262         $iprange &= "$ipmask";
263     } elsif ( $pattern =~ m/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\/(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/ ) {
264         # 1.1.1.1/255.255.255.255 notation
265         $iprange = pack( "U4", $1, $2, $3, $4 );
266         $ipmask  = pack( "U4", $5, $6, $7, $8 );
267         $iprange &= "$ipmask";
268     } elsif ( $pattern =~ m/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ ) {
269         # 1.1.1.1 notation
270         $iprange = pack( "U4", $1, $2, $3, $4 );
271         $ipmask = pack( "U4", 255, 255, 255, 255 );
272     } elsif ( $pattern =~ m/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\s*\-\s*(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ ) {
273         # 1.1.1.1 - 2.2.2.2 notation
274         $iprange  = pack( "U4", $1,  $2,  $3,  $4 );
275         $iprange2 = pack( "U4", $5,  $6,  $7,  $8 );
276         $ipmask   = pack( "U4", 255, 255, 255, 255 );
277     } else {
278         return;
279     }
280         return $iprange, $ipmask, $iprange2;
281 }
282
283 sub parse {
284     my ( $origip, $ipbase, $ipmask, $iprange2 ) = @_;
285     $origip =~ m/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;
286     $origip = pack( "U4", $1, $2, $3, $4 );
287     if ( defined($iprange2) ) {
288         if ( $ipbase le $origip && $origip le $iprange2 ) {
289             return $val = 'true';
290         } else {
291             return $val = 'false';
292         }
293     } elsif ( ( "$origip" & "$ipmask" ) eq $ipbase ) {
294         return $val = 'true';
295     } else {
296         return $val = 'false';
297     }
298 }
299
300 # This sub will distinguish the drive mappings
301 sub drive_map {
302     my @data = @_;
303     for ( my $i = 0 ; $i < scalar(@data) ; ) {
304         if ( $data[$i] =~ m/^[a-z]\:$/i ) {
305             my $driveletter = $data[$i];
306             $i++;
307             my $sharename = $data[$i];
308             $i++;
309             if ( $sharename eq '/home' ) {
310                 print LOGON uc("NET USE $driveletter $sharename \/Y \r\n");
311             } else {
312                 print LOGON
313                   uc("NET USE $driveletter \\\\$server\\$sharename \/Y \r\n");
314             }
315         } else {
316             print LOGON uc("$data[$i] \r\n");
317             $i++;
318         }
319     }
320 }
321
322 close(LOGON);
323
324 sub error {
325     my $var = shift(@_);
326     help();
327     print "\n\tCritical!!! \n\n\tNo $var specified\n\n\tYou must specify a $var.\n\n";
328     exit(0);
329 }
330
331 sub help {
332
333     print << "EOF" ;
334
335         Usage:   $0 [options]
336
337         Options:
338
339         -h,--help               This help screen.
340
341         -u,--username           The name of the user from the samba server.
342
343         -m,--machinename        The name of the client connecting to the server.
344
345         -s,--server             The name of the server this script is running in.
346
347         -o,--os                 The clients OS -- Windows 95/98/ME (Win95), Windows NT (WinNT),
348                                 Windows 2000 (Win2K), Windows  XP  (WinXP), and Windows 2003
349                                 (Win2K3). Anything else will be known as ``UNKNOWN''
350                                 That snippet is directly from man smb.conf. 
351
352         -i,--ip                 The clients IP address.
353
354         -d,--date               Time and Date returned from the samba server.
355
356
357
358                                 --IMPORTANT--           
359                 
360
361                                 All options MUST be specified.
362         
363                                 The mklogon.conf file MUST be located in /etc, /etc/samba, or 
364                                 /usr/local/samba/lib.
365         
366         To use this file from the command line:
367                 $0 -u User -m machine -s servername -o ostype -i X.X.X.X -d MM/DD/YY
368
369         To use this file from the samba server add these lines to your /etc/samba/smb.conf:
370
371
372                 This line goes in the [global] section
373                         login script = %U.bat
374
375                 This line should be at the end of the [netlogon] section.
376                         root preexec = /path/to/mklogon.pl -u %U -m %m -s %L -o %a -i %I -d %t
377         
378         
379 EOF
380
381     print "\n\n";
382
383 }