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.0 (Stable)
26# Revised: 07/28/2005
27
28# Comments...
29# Working on logging to the system logs, Logs user activity, but not errors yet.
30
31use strict;
32use Getopt::Long;
33
34eval { require Config::Simple; };
35if ($@) {
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
51my $configfile;
52
53foreach 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.
61my $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
71if ($help) {
72    help();
73    exit(0);
74}
75
76# We want the program to error out if its missing an argument.
77if ( !defined($user) )    { error("username"); }
78if ( !defined($machine) ) { error("machine name") }
79if ( !defined($server) )  { error("server name") }
80if ( !defined($os) )      { error("operating system") }
81if ( !defined($ip) )      { error("ip address") }
82if ( !defined($smbdate) ) { error("date") }
83
84# This section will be read from the external config file
85my $cfg = new Config::Simple($configfile) or die "Could not find $configfile";
86
87# Read this part from the samba config
88my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time);
89my $sambaconf = $cfg->param("global.sambaconf") or die "Couldn't find your samba config! \n";
90my $smbcfg = new Config::Simple( filename => $sambaconf, syntax => "ini" );
91my $smbprof = $smbcfg->param("profiles.path");
92my $smbnetlogdir = $smbcfg->param("netlogon.path");
93my $logging      = lc( $cfg->param("global.logging") );
94my $mkprofile    = lc( $cfg->param("global.mkprofile") );
95my $logdir       = $cfg->param("global.logdir");
96my $logfile      = $cfg->param("global.logfile");
97my $logs         = "$logdir\/$logfile";
98my $logtype	 = $cfg->param("global.logtype");
99my $usermap      = "usermap.$user";
100my $osmap	 = "os.$os";
101my @ostype	 = $cfg->param($osmap);
102my @username     = $cfg->param($usermap);
103my $compname     = $cfg->param( -block => "machines" );
104my $ipname       = $cfg->param( -block => "ip" );
105my $timesync     = $cfg->param("global.timesync");
106my $altserver    = $cfg->param("global.servername");
107if ( defined($altserver) ) { $server = $altserver; }
108$server = uc($server);
109
110# Lets start logging stuff if it is turned on in the config
111if ( $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
137if ( 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 with a uid of $uid\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.
162open LOGON, ">$smbnetlogdir\/$user.bat" or die "Unable to create userfile $smbnetlogdir\/$user.bat";
163print LOGON "\@ECHO OFF \r\n";
164
165if ( $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
172my $common = $cfg->param( -block => "common" );
173for my $key ( keys %$common ) {
174    drive_map( @{ $common->{$key} } );
175}
176
177my @perform_common = $cfg->param("performcommands.common");
178if ( defined( $perform_common[0] ) ) {
179    foreach (@perform_common) {
180        print LOGON "$_ \r\n";
181    }
182}
183
184# Map shares on a per user basis.
185drive_map(@username);
186
187# Map shares based on the Operating System.
188drive_map(@ostype);
189
190# Map shares only if they are in a group
191# This line checks against the unix "groups" command, to see the secondary groups of a user.
192my @usergroups = split( /\s/, do { open my $groups, "-|", groups => $user; <$groups> } );
193foreach (@usergroups) {
194    my $groupmap  = "groupmap.$_";
195    my @groupname = $cfg->param($groupmap);
196    drive_map(@groupname);
197}
198
199#Here is where we check the machine name against the config...
200for my $key ( keys %$compname ) {
201    my $test = $compname->{$key};
202    if ( ref $test eq 'ARRAY' ) {
203        foreach (@$test) {
204            if ( $_ eq $machine ) {
205                my $performit = $cfg->param("performcommands.$key");
206                if ( defined($performit) ) {
207                    if ( ref $performit ) {
208                        foreach (@$performit) { print LOGON "$_ \r\n"; }
209                    } else {
210                        print LOGON "$performit \r\n";
211                    }
212                }
213            }
214        }
215    }
216    elsif ( $test eq $machine ) {
217        my $performit = $cfg->param("performcommands.$key");
218        if ( defined($performit) ) {
219            if ( ref $performit ) {
220                foreach (@$performit) { print LOGON "$_ \r\n"; }
221            } else {
222                print LOGON "$performit \r\n";
223            }
224        }
225    }
226}
227
228# Here is where we test the ip address against the client to see if they have "Special Mapping"
229# A huge portion of the ip matching code was made by
230# Carsten Schaub (rcsu in the #samba chan on freenode.net)
231
232my $val;
233for my $key ( sort keys %$ipname ) {
234    if ( ref $ipname->{$key} eq 'ARRAY' ) {
235        foreach ( @{ $ipname->{$key} } ) {
236            getipval( $_, $key );
237        }
238    } else {
239        getipval( $ipname->{$key}, $key );
240    }
241}
242
243sub getipval {
244    my ( $range, $rangename ) = @_;
245    if ( parse( $ip, ipmap($range) ) ) {
246        if ( $val eq 'true' ) {
247            my $performit = $cfg->param("performcommands.$rangename");
248            if ( defined($performit) ) {
249                if ( ref $performit ) {
250                    foreach (@$performit) { print LOGON "$_ \r\n"; }
251                } else {
252                    print LOGON "$performit \r\n";
253                }
254            }
255        } elsif ( $val eq 'false' ) {
256        }
257    } else {
258    }
259}
260
261sub ipmap {
262    my $pattern = shift;
263    my ( $iprange, $iprange2, $ipmask );
264    if ( $pattern =~ m/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\/(\d{1,2})$/ ) {
265        # 1.1.1.1/3 notation
266        $iprange = pack( "U4", $1, $2, $3, $4 );
267        $ipmask = pack( "U4", 0, 0, 0, 0 );
268        my $numbits = $5;
269        for ( my $i = 0 ; $i < $numbits ; $i++ ) {
270            vec( $ipmask, int( $i / 8 ) * 8 + ( 8 - ( $i % 8 ) ) - 1, 1 ) = 1;
271        }
272        $iprange &= "$ipmask";
273    } 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})/ ) {
274        # 1.1.1.1/255.255.255.255 notation
275        $iprange = pack( "U4", $1, $2, $3, $4 );
276        $ipmask  = pack( "U4", $5, $6, $7, $8 );
277        $iprange &= "$ipmask";
278    } elsif ( $pattern =~ m/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ ) {
279        # 1.1.1.1 notation
280        $iprange = pack( "U4", $1, $2, $3, $4 );
281        $ipmask = pack( "U4", 255, 255, 255, 255 );
282    } 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})$/ ) {
283        # 1.1.1.1 - 2.2.2.2 notation
284        $iprange  = pack( "U4", $1,  $2,  $3,  $4 );
285        $iprange2 = pack( "U4", $5,  $6,  $7,  $8 );
286        $ipmask   = pack( "U4", 255, 255, 255, 255 );
287    } else {
288        return;
289    }
290	return $iprange, $ipmask, $iprange2;
291}
292
293sub parse {
294    my ( $origip, $ipbase, $ipmask, $iprange2 ) = @_;
295    $origip =~ m/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;
296    $origip = pack( "U4", $1, $2, $3, $4 );
297    if ( defined($iprange2) ) {
298        if ( $ipbase le $origip && $origip le $iprange2 ) {
299            return $val = 'true';
300        } else {
301            return $val = 'false';
302        }
303    } elsif ( ( "$origip" & "$ipmask" ) eq $ipbase ) {
304        return $val = 'true';
305    } else {
306        return $val = 'false';
307    }
308}
309
310# This sub will distinguish the drive mappings
311sub drive_map {
312    my @data = @_;
313    for ( my $i = 0 ; $i < scalar(@data) ; ) {
314        if ( $data[$i] =~ m/^[a-z]\:$/i ) {
315            my $driveletter = $data[$i];
316            $i++;
317            my $sharename = $data[$i];
318            $i++;
319            if ( $sharename eq '/home' ) {
320                print LOGON uc("NET USE $driveletter \\\\$server\\$user \/Y \r\n");
321            } else {
322                print LOGON
323                  uc("NET USE $driveletter \\\\$server\\$sharename \/Y \r\n");
324            }
325        } else {
326            print LOGON uc("$data[$i] \r\n");
327            $i++;
328        }
329    }
330}
331
332close(LOGON);
333
334sub error {
335    my $var = shift(@_);
336    help();
337    print "\n\tCritical!!! \n\n\tNo $var specified\n\n\tYou must specify a $var.\n\n";
338    exit(0);
339}
340
341sub help {
342
343    print << "EOF" ;
344
345	Usage:   $0 [options]
346
347	Options:
348
349	-h,--help		This help screen.
350
351	-u,--username		The name of the user from the samba server.
352
353	-m,--machinename	The name of the client connecting to the server.
354
355	-s,--server		The name of the server this script is running in.
356
357	-o,--os			The clients OS -- Windows 95/98/ME (Win95), Windows NT (WinNT),
358				Windows 2000 (Win2K), Windows  XP  (WinXP), and Windows 2003
359				(Win2K3). Anything else will be known as ``UNKNOWN''
360				That snippet is directly from man smb.conf.
361
362	-i,--ip			The clients IP address.
363
364	-d,--date		Time and Date returned from the samba server.
365
366
367
368				--IMPORTANT--
369
370
371				All options MUST be specified.
372
373				The mklogon.conf file MUST be located in /etc, /etc/samba, or
374				/usr/local/samba/lib.
375
376	To use this file from the command line:
377		$0 -u User -m machine -s servername -o ostype -i X.X.X.X -d MM/DD/YY
378
379	To use this file from the samba server add these lines to your /etc/samba/smb.conf:
380
381
382		This line goes in the [global] section
383			login script = %U.bat
384
385		This line should be at the end of the [netlogon] section.
386			root preexec = /path/to/mklogon.pl -u %U -m %m -s %L -o %a -i %I -d %t
387
388
389EOF
390
391    print "\n\n";
392
393}
394