lib/async_req: remove the tevent_fd as early as possible via a wait_for_read_cleanup...
[Samba.git] / examples / logon / mklogon / mklogon.pl
blob870abd192c1b218e702d557b52305799c2dbc578
1 #!/usr/bin/perl -w
3 # 05/01/2005 - 18:07:10
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
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.
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.
20 # You should have received a copy of the GNU General Public License
21 # along with this program; if not, see <http://www.gnu.org/licenses/>.
24 # Version: 1.0 (Stable)
25 # Revised: 07/28/2005
27 # Comments...
28 # Working on logging to the system logs, Logs user activity, but not errors yet.
30 use strict;
31 use Getopt::Long;
33 eval { require Config::Simple; };
34 if ($@) {
35 print("\n");
36 print( "It appears as though you don't have the Config Simple perl module installed.\n" );
37 print("The package is typically called 'Config::Simple' \n");
38 print("and it needs to be installed, before you can use this utility\n");
39 print("Most PERL installations will allow you to use a command like\n");
40 print("\ncpan -i Config::Simple\n");
41 print("from the command line while logged in as the root user.\n");
42 print("\n");
43 exit(1);
46 # use Data::Dumper; #Used for debugging purposes
48 # This variable should point to the external conf file, personally I would set
49 # it to /etc/samba/mklogon.conf
50 my $configfile;
52 foreach my $dir ( ( '/etc', '/etc/samba', '/usr/local/samba/lib' ) ) {
53 if ( -e "$dir/mklogon.conf" ) {
54 $configfile = "$dir/mklogon.conf";
55 last;
59 # This section will come directly from the samba server. Basically it just makes the script easier to read.
60 my $getopts = GetOptions(
61 'u|username=s' => \my $user,
62 'm|machine=s' => \my $machine,
63 's|servername=s' => \my $server,
64 'o|ostype=s' => \my $os,
65 'i|ip=s' => \my $ip,
66 'd|date=s' => \my $smbdate,
67 'h|help|?' => \my $help
70 if ($help) {
71 help();
72 exit(0);
75 # We want the program to error out if its missing an argument.
76 if ( !defined($user) ) { error("username"); }
77 if ( !defined($machine) ) { error("machine name") }
78 if ( !defined($server) ) { error("server name") }
79 if ( !defined($os) ) { error("operating system") }
80 if ( !defined($ip) ) { error("ip address") }
81 if ( !defined($smbdate) ) { error("date") }
83 # This section will be read from the external config file
84 my $cfg = new Config::Simple($configfile) or die "Could not find $configfile";
86 # Read this part from the samba config
87 my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time);
88 my $sambaconf = $cfg->param("global.sambaconf") or die "Couldn't find your samba config! \n";
89 my $smbcfg = new Config::Simple( filename => $sambaconf, syntax => "ini" );
90 my $smbprof = $smbcfg->param("profiles.path");
91 my $smbnetlogdir = $smbcfg->param("netlogon.path");
92 my $logging = lc( $cfg->param("global.logging") );
93 my $mkprofile = lc( $cfg->param("global.mkprofile") );
94 my $logdir = $cfg->param("global.logdir");
95 my $logfile = $cfg->param("global.logfile");
96 my $logs = "$logdir\/$logfile";
97 my $logtype = $cfg->param("global.logtype");
98 my $usermap = "usermap.$user";
99 my $osmap = "os.$os";
100 my @ostype = $cfg->param($osmap);
101 my @username = $cfg->param($usermap);
102 my $compname = $cfg->param( -block => "machines" );
103 my $ipname = $cfg->param( -block => "ip" );
104 my $timesync = $cfg->param("global.timesync");
105 my $altserver = $cfg->param("global.servername");
106 if ( defined($altserver) ) { $server = $altserver; }
107 $server = uc($server);
109 # Lets start logging stuff if it is turned on in the config
110 if ( $logging =~ m/on|yes|1/i ) {
111 if ($logtype =~ m/file/i) {
112 print "----- Logging is turned on in the config. -----\n";
113 print "----- Location of the logfile is \"$logs\" -----\n";
114 open LOG, ">>$logs";
115 printf LOG "Date: $smbdate Time: ";
116 printf LOG '%02d', $hour;
117 print LOG ":";
118 printf LOG '%02d', $min;
119 print LOG ".";
120 printf LOG '%02d', $sec;
121 print LOG " -- User: $user - Machine: $machine - IP: $ip -- \n";
122 close(LOG);
123 } elsif ($logtype =~ m/syslog|system/i){
124 use Sys::Syslog;
125 my $alert = "User: $user Logged into $machine ($ip) at $hour:$min.$sec on $smbdate.";
126 openlog($0, 'cons', 'user');
127 syslog('alert', $alert);
128 closelog();
131 } else {
132 print "----- Logging is turned off in the config. -----\n";
135 # If the user wants to make profiles with this script lets go
136 if ( defined($smbprof) ) {
137 if ( $mkprofile =~ m/on|yes|1/i ) {
138 print "----- Automatic making of user profiles is turned on in the config. ----- \n";
139 ( my $login, my $pass, my $uid, my $gid ) = getpwnam($user)
140 or die "$user not in passwd file \n";
141 $smbprof =~ s/\%U/$user/g;
142 my $dir2 = "$smbprof\/$user";
143 print "$smbprof \n";
144 print "$dir2 \n";
145 if ( !-e $dir2 ) {
146 print "Creating " . $user . "'s profile with a uid of $uid\n";
147 mkdir $smbprof;
148 mkdir $dir2;
149 chomp($user);
150 # chown $uid, $gid, $smbprof;
151 chown $uid, $gid, $dir2;
152 } else {
153 print $user . "'s profile already exists \n";
155 } else {
156 print "----- Automatic making of user profiles is turned off in the config. ----- \n";
160 # Lets start making the batch files.
161 open LOGON, ">$smbnetlogdir\/$user.bat" or die "Unable to create userfile $smbnetlogdir\/$user.bat";
162 print LOGON "\@ECHO OFF \r\n";
164 if ( $timesync =~ m/on|yes|1/i ) {
165 print LOGON "NET TIME /SET /YES \\\\$server \r\n";
166 } else {
167 print "----- Time syncing to the client is turned off in the config. -----\n";
170 # Mapping from the common section
171 my $common = $cfg->param( -block => "common" );
172 for my $key ( keys %$common ) {
173 drive_map( @{ $common->{$key} } );
176 my @perform_common = $cfg->param("performcommands.common");
177 if ( defined( $perform_common[0] ) ) {
178 foreach (@perform_common) {
179 print LOGON "$_ \r\n";
183 # Map shares on a per user basis.
184 drive_map(@username);
186 # Map shares based on the Operating System.
187 drive_map(@ostype);
189 # Map shares only if they are in a group
190 # This line checks against the unix "groups" command, to see the secondary groups of a user.
191 my @usergroups = split( /\s/, do { open my $groups, "-|", groups => $user; <$groups> } );
192 foreach (@usergroups) {
193 my $groupmap = "groupmap.$_";
194 my @groupname = $cfg->param($groupmap);
195 drive_map(@groupname);
198 #Here is where we check the machine name against the config...
199 for my $key ( keys %$compname ) {
200 my $test = $compname->{$key};
201 if ( ref $test eq 'ARRAY' ) {
202 foreach (@$test) {
203 if ( $_ eq $machine ) {
204 my $performit = $cfg->param("performcommands.$key");
205 if ( defined($performit) ) {
206 if ( ref $performit ) {
207 foreach (@$performit) { print LOGON "$_ \r\n"; }
208 } else {
209 print LOGON "$performit \r\n";
215 elsif ( $test eq $machine ) {
216 my $performit = $cfg->param("performcommands.$key");
217 if ( defined($performit) ) {
218 if ( ref $performit ) {
219 foreach (@$performit) { print LOGON "$_ \r\n"; }
220 } else {
221 print LOGON "$performit \r\n";
227 # Here is where we test the ip address against the client to see if they have "Special Mapping"
228 # A huge portion of the ip matching code was made by
229 # Carsten Schaub (rcsu in the #samba chan on freenode.net)
231 my $val;
232 for my $key ( sort keys %$ipname ) {
233 if ( ref $ipname->{$key} eq 'ARRAY' ) {
234 foreach ( @{ $ipname->{$key} } ) {
235 getipval( $_, $key );
237 } else {
238 getipval( $ipname->{$key}, $key );
242 sub getipval {
243 my ( $range, $rangename ) = @_;
244 if ( parse( $ip, ipmap($range) ) ) {
245 if ( $val eq 'true' ) {
246 my $performit = $cfg->param("performcommands.$rangename");
247 if ( defined($performit) ) {
248 if ( ref $performit ) {
249 foreach (@$performit) { print LOGON "$_ \r\n"; }
250 } else {
251 print LOGON "$performit \r\n";
254 } elsif ( $val eq 'false' ) {
256 } else {
260 sub ipmap {
261 my $pattern = shift;
262 my ( $iprange, $iprange2, $ipmask );
263 if ( $pattern =~ m/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\/(\d{1,2})$/ ) {
264 # 1.1.1.1/3 notation
265 $iprange = pack( "U4", $1, $2, $3, $4 );
266 $ipmask = pack( "U4", 0, 0, 0, 0 );
267 my $numbits = $5;
268 for ( my $i = 0 ; $i < $numbits ; $i++ ) {
269 vec( $ipmask, int( $i / 8 ) * 8 + ( 8 - ( $i % 8 ) ) - 1, 1 ) = 1;
271 $iprange &= "$ipmask";
272 } 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})/ ) {
273 # 1.1.1.1/255.255.255.255 notation
274 $iprange = pack( "U4", $1, $2, $3, $4 );
275 $ipmask = pack( "U4", $5, $6, $7, $8 );
276 $iprange &= "$ipmask";
277 } elsif ( $pattern =~ m/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ ) {
278 # 1.1.1.1 notation
279 $iprange = pack( "U4", $1, $2, $3, $4 );
280 $ipmask = pack( "U4", 255, 255, 255, 255 );
281 } 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})$/ ) {
282 # 1.1.1.1 - 2.2.2.2 notation
283 $iprange = pack( "U4", $1, $2, $3, $4 );
284 $iprange2 = pack( "U4", $5, $6, $7, $8 );
285 $ipmask = pack( "U4", 255, 255, 255, 255 );
286 } else {
287 return;
289 return $iprange, $ipmask, $iprange2;
292 sub parse {
293 my ( $origip, $ipbase, $ipmask, $iprange2 ) = @_;
294 $origip =~ m/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;
295 $origip = pack( "U4", $1, $2, $3, $4 );
296 if ( defined($iprange2) ) {
297 if ( $ipbase le $origip && $origip le $iprange2 ) {
298 return $val = 'true';
299 } else {
300 return $val = 'false';
302 } elsif ( ( "$origip" & "$ipmask" ) eq $ipbase ) {
303 return $val = 'true';
304 } else {
305 return $val = 'false';
309 # This sub will distinguish the drive mappings
310 sub drive_map {
311 my @data = @_;
312 for ( my $i = 0 ; $i < scalar(@data) ; ) {
313 if ( $data[$i] =~ m/^[a-z]\:$/i ) {
314 my $driveletter = $data[$i];
315 $i++;
316 my $sharename = $data[$i];
317 $i++;
318 if ( $sharename eq '/home' ) {
319 print LOGON uc("NET USE $driveletter \\\\$server\\$user \/Y \r\n");
320 } else {
321 print LOGON
322 uc("NET USE $driveletter \\\\$server\\$sharename \/Y \r\n");
324 } else {
325 print LOGON uc("$data[$i] \r\n");
326 $i++;
331 close(LOGON);
333 sub error {
334 my $var = shift(@_);
335 help();
336 print "\n\tCritical!!! \n\n\tNo $var specified\n\n\tYou must specify a $var.\n\n";
337 exit(0);
340 sub help {
342 print << "EOF" ;
344 Usage: $0 [options]
346 Options:
348 -h,--help This help screen.
350 -u,--username The name of the user from the samba server.
352 -m,--machinename The name of the client connecting to the server.
354 -s,--server The name of the server this script is running in.
356 -o,--os The clients OS -- Windows 95/98/ME (Win95), Windows NT (WinNT),
357 Windows 2000 (Win2K), Windows XP (WinXP), and Windows 2003
358 (Win2K3). Anything else will be known as ``UNKNOWN''
359 That snippet is directly from man smb.conf.
361 -i,--ip The clients IP address.
363 -d,--date Time and Date returned from the samba server.
367 --IMPORTANT--
370 All options MUST be specified.
372 The mklogon.conf file MUST be located in /etc, /etc/samba, or
373 /usr/local/samba/lib.
375 To use this file from the command line:
376 $0 -u User -m machine -s servername -o ostype -i X.X.X.X -d MM/DD/YY
378 To use this file from the samba server add these lines to your /etc/samba/smb.conf:
381 This line goes in the [global] section
382 login script = %U.bat
384 This line should be at the end of the [netlogon] section.
385 root preexec = /path/to/mklogon.pl -u %U -m %m -s %L -o %a -i %I -d %t
390 print "\n\n";