pptp-server/pptp-server-lib.pl

   1 # pptp-server-lib.pl
   2 # Common functions for PPTP server configuration
   3 # XXX help pages
   4
   5 BEGIN { push(@INC, ".."); };
   6 use WebminCore;
   7 &init_config();
   8 do 'secrets-lib.pl';
   9 %access = &get_module_acl();
  10
  11 $options_pptp = $config{'pptp_ppp_options'} || "/etc/ppp/options.pptp";
  12
  13 # get_config()
  14 # Returns the PPTP configuration
  15 sub get_config
  16 {
  17 local @rv;
  18 local $lnum = 0;
  19 open(FILE, $config{'file'});
  20 while(<FILE>) {
  21         s/\r|\n//g;
  22         if (/^\s*(#?)\s*(\S+)\s*(\S*)\s*$/) {
  23                 push(@rv, { 'name' => $2,
  24                             'value' => $3,
  25                             'enabled' => !$1,
  26                             'line' => $lnum,
  27                             'index' => scalar(@rv) });
  28                 }
  29         $lnum++;
  30         }
  31 close(FILE);
  32 return \@rv;
  33 }
  34
  35 # find_conf(name, &config)
  36 sub find_conf
  37 {
  38 local $c;
  39 foreach $c (@{$_[1]}) {
  40         if (lc($c->{'name'}) eq lc($_[0]) && $c->{'enabled'}) {
  41                 return $c->{'value'};
  42                 }
  43         }
  44 return undef;
  45 }
  46
  47 # save_directive(&config, name, [value])
  48 sub save_directive
  49 {
  50 local $lref = &read_file_lines($config{'file'});
  51 local ($old) = grep { lc($_->{'name'}) eq lc($_[1]) } @{$_[0]};
  52 if ($old) {
  53         if (defined($_[2])) {
  54                 # Can just update old one
  55                 $lref->[$old->{'line'}] = "$_[1]\t$_[2]";
  56                 }
  57         elsif ($old->{'enabled'}) {
  58                 # Comment out old one
  59                 $lref->[$old->{'line'}] = "#$old->{'name'}\t$old->{'value'}";
  60                 }
  61         }
  62 elsif (defined($_[2])) {
  63         # Add to end of file
  64         push(@$lref, "$_[1]\t$_[2]");
  65         }
  66 }
  67
  68 # get_pptpd_pid()
  69 # Returns the PID of the running PPTP server process
  70 sub get_pptpd_pid
  71 {
  72 open(PID, $config{'pid_file'}) || return undef;
  73 local $pid = <PID>;
  74 $pid = int($pid);
  75 close(PID);
  76 return $pid;
  77 }
  78
  79 # get_ppp_hostname()
  80 # Returns the hostname that this server uses for authentication
  81 sub get_ppp_hostname
  82 {
  83 local $conf = &get_config();
  84 local $option = &find_conf("option", $conf);
  85 $option ||= $config{'ppp_options'};
  86 local @opts = &parse_ppp_options($option);
  87 local $name = &find("name", \@opts);
  88 return $name ? $name->{'value'} : &get_system_hostname(1);
  89 }
  90
  91 # parse_ppp_options(file)
  92 sub parse_ppp_options
  93 {
  94 local @rv;
  95 local $lnum = 0;
  96 open(OPTS, $_[0]);
  97 while(<OPTS>) {
  98         s/\r|\n//g;
  99         s/#.*$//g;
 100         if (/^([0-9\.]+):([0-9\.]+)/) {
 101                 push(@rv, { 'local' => $1,
 102                             'remote' => $2,
 103                             'file' => $_[0],
 104                             'line' => $lnum,
 105                             'index' => scalar(@rv) });
 106                 }
 107         elsif (/^(\S+)\s*(.*)/) {
 108                 push(@rv, { 'name' => $1,
 109                             'value' => $2,
 110                             'file' => $_[0],
 111                             'line' => $lnum,
 112                             'index' => scalar(@rv) });
 113                 }
 114         $lnum++;
 115         }
 116 close(OPTS);
 117 return @rv;
 118 }
 119
 120 # find(name, &config)
 121 sub find
 122 {
 123 local @rv = grep { lc($_->{'name'}) eq lc($_[0]) } @{$_[1]};
 124 return wantarray ? @rv : $rv[0];
 125 }
 126
 127 # save_ppp_option(&config, file, &old|name, &new)
 128 sub save_ppp_option
 129 {
 130 local $ol = ref($_[2]) || !defined($_[2]) ? $_[2] : &find($_[2], $_[0]);
 131 local $nw = $_[3];
 132 local $lref = &read_file_lines($_[1]);
 133 local $line;
 134 if ($nw) {
 135         if ($nw->{'local'}) {
 136                 $line = $nw->{'local'}.":".$nw->{'remote'};
 137                 }
 138         else {
 139                 $line = $nw->{'name'};
 140                 $line .= " $nw->{'value'}" if ($nw->{'value'} ne "");
 141                 }
 142         }
 143 if ($ol && $nw) {
 144         $lref->[$ol->{'line'}] = $line;
 145         }
 146 elsif ($ol) {
 147         splice(@$lref, $ol->{'line'}, 1);
 148         local $c;
 149         foreach $c (@{$_[0]}) {
 150                 $c->{'line'}-- if ($c->{'line'} > $ol->{'line'});
 151                 }
 152         }
 153 elsif ($nw) {
 154         push(@$lref, $line);
 155         }
 156 }
 157
 158 # list_connections()
 159 # Returns a list of active PPTP connections by checking the process list.
 160 # Each element of the list is an array containing the PPP PID, PPTP PID,
 161 # client IP, interface, local IP and remote IP, start time and username
 162 sub list_connections
 163 {
 164 local @rv;
 165
 166 # Look in the log file for connection messages
 167 local (%pppuser, %localip, %remoteip);
 168 &open_readfile(LOG, $config{'log_file'});
 169 while(<LOG>) {
 170         if (/pppd\[(\d+)\].*authentication\s+succeeded\s+for\s+(\S+)/i) {
 171                 $pppuser{$1} = $2;
 172                 }
 173         elsif (/pppd\[(\d+)\].*local\s+IP\s+address\s+(\S+)/) {
 174                 $localip{$1} = $2;
 175                 }
 176         elsif (/pppd\[(\d+)\].*remote\s+IP\s+address\s+(\S+)/) {
 177                 $remoteip{$1} = $2;
 178                 }
 179         }
 180 close(LOG);
 181
 182 # Check for running pptpd and pppd processes
 183 &foreign_require("proc", "proc-lib.pl");
 184 &foreign_require("net", "net-lib.pl");
 185 local @procs = &proc::list_processes();
 186 local @ifaces = &net::active_interfaces();
 187 foreach $p (@procs) {
 188         if ($p->{'args'} =~ /pptpd\s*\[([0-9\.]+)/) {
 189                 # Found a PPTP connection process .. get the child PPP proc
 190                 local $rip = $1;
 191                 local ($ppp) = grep { $_->{'ppid'} == $p->{'pid'} } @procs;
 192                 local $user = $ppp ? $pppuser{$ppp->{'pid'}} : undef;
 193                 local $lip;
 194                 if ($ppp && ($lip=$localip{$ppp->{'pid'}})) {
 195                         # We got the local and remote IPs from the log file
 196                         local $rip2 = $remoteip{$ppp->{'pid'}};
 197                         local ($iface) = grep { $_->{'address'} eq $lip &&
 198                                                 $_->{'ptp'} eq $rip } @ifaces;
 199                         push(@rv, [ $ppp->{'pid'}, $p->{'pid'},
 200                                     $rip, $iface ? $iface->{'fullname'} : undef,
 201                                     $lip, $rip2,
 202                                     $ppp->{'_stime'}, $user ] );
 203                         }
 204                 elsif ($ppp && $ppp->{'args'} =~ /([0-9\.]+):([0-9\.]+)/) {
 205                         # Find the matching interface
 206                         local ($iface) = grep { $_->{'address'} eq $1 &&
 207                                                 $_->{'ptp'} eq $2 } @ifaces;
 208                         if ($iface) {
 209                                 push(@rv, [ $ppp->{'pid'}, $p->{'pid'},
 210                                             $rip, $iface->{'fullname'},
 211                                             $1, $iface->{'ptp'} || $2,
 212                                             $ppp->{'_stime'}, $user ] );
 213                                 }
 214                         else {
 215                                 push(@rv, [ $ppp->{'pid'}, $p->{'pid'},
 216                                             $rip, undef, $1, $2,
 217                                             $ppp->{'_stime'}, $user ] );
 218                                 }
 219                         }
 220                 elsif ($ppp) {
 221                         # PPP process doesn't include IPs
 222                         push(@rv, [ $ppp->{'pid'}, $p->{'pid'},
 223                                     $rip, undef, undef, undef,
 224                                     $ppp->{'_stime'}, $user ] );
 225                         }
 226                 }
 227         }
 228 return @rv;
 229 }
 230
 231 # get_pptpd_version(&out)
 232 sub get_pptpd_version
 233 {
 234 local $out = `$config{'pptpd'} -v 2>&1`;
 235 ${$_[0]} = $out;
 236 return $out =~ /(PoPToP|pptpd)\s+v?(\S+)/i ? $2 : undef;
 237 }
 238
 239 # apply_configuration()
 240 # Attempts to apply the PPTP server configuration, and returns undef on
 241 # success or an error message on failure
 242 sub apply_configuration
 243 {
 244 # Stop first
 245 if ($config{'stop_cmd'}) {
 246         local $out = &backquote_logged("$config{'stop_cmd'} 2>&1 </dev/null");
 247         return "<pre>$out</pre>" if ($?);
 248         }
 249 else {
 250         local $pid = &get_pptpd_pid();
 251         if (!$pid || !&kill_logged('TERM', $pid)) {
 252                 return $text{'stop_egone'};
 253                 }
 254         }
 255
 256 # Re-start
 257 local $cmd = $config{'start_cmd'} || $config{'pptpd'};
 258 local $temp = &tempname();
 259 local $rv = &system_logged("$cmd >$temp 2>&1 </dev/null");
 260 local $out = `cat $temp`;
 261 unlink($temp);
 262 if ($rv) {
 263         return "<pre>$out</pre>";
 264         }
 265 return undef;
 266 }
 267
 268 1;
 269