353 lines
8.3 KiB
Perl
353 lines
8.3 KiB
Perl
|
#!/usr/bin/perl
|
||
|
|
|
||
|
|
# 0.05 20040220 haegar@ccc.de
|
||
|
|
# - pfad zu /sbin/ip in eine Variable auslagern
|
||
|
|
#
|
||
|
|
# 0.04 20031203 haegar@ccc.de
|
||
|
|
# - config in ein externes configfile ausgelagert
|
||
|
|
# - abschiessen eines schon laufenden chaosvpn-daemons umgebaut,
|
||
|
|
# da der normale weg nicht immer funktioniert
|
||
|
|
#
|
||
|
|
# 0.03 20031202 haegar@ccc.de
|
||
|
|
# - debug-logging per default an, damit man mehr sieht
|
||
|
|
# - unbenutzte config-variablen als solche kommentiert
|
||
|
|
#
|
||
|
|
# 0.02 20031020 haegar@ccc.de
|
||
|
|
# - peer-excludes funktionierten nicht
|
||
|
|
#
|
||
|
|
# v0.01 20031019 haegar@ccc.de
|
||
|
|
# - first revision
|
||
|
|
|
||
|
|
# JA, ICH WEISS HIER FEHLT NOCH VIEL UND ES IST AN DIVERSEN STELLEN
|
||
|
|
# EXTREM DRECKIG RUNTERGEHACKT ;)
|
||
|
|
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use LWP::UserAgent;
|
||
|
|
use HTTP::Request;
|
||
|
|
use CGI;
|
||
|
|
use Data::Dumper;
|
||
|
|
|
||
|
|
|
||
|
|
my $config = "/etc/tinc/chaosvpn.conf";
|
||
|
|
|
||
|
|
|
||
|
|
# config-vars:
|
||
|
|
use vars qw(
|
||
|
|
$my_peerid $my_vpn_ip $my_vpn_netmask $my_vpn_ip6
|
||
|
|
@exclude
|
||
|
|
$my_password $my_ip $my_external_ip
|
||
|
|
$networkname $tincd_bin $ifconfig $ifconfig6 $ip_bin
|
||
|
|
$master_url $base $pidfile $tincd_debuglevel
|
||
|
|
);
|
||
|
|
|
||
|
|
# defaults:
|
||
|
|
$my_peerid = "undef";
|
||
|
|
$my_vpn_ip = "";
|
||
|
|
$my_vpn_netmask = "255.255.255.255";
|
||
|
|
$my_vpn_ip6 = "";
|
||
|
|
|
||
|
|
$my_password = ""; # unused
|
||
|
|
$my_ip = ""; # unused for now
|
||
|
|
$my_external_ip = ""; # unused
|
||
|
|
|
||
|
|
@exclude = (); # links zu gewissen peer-ids nicht aufbauen
|
||
|
|
|
||
|
|
# ============================================================================
|
||
|
|
# you should'nt need to change anything below,
|
||
|
|
# at least not for linux and chaosvpn
|
||
|
|
|
||
|
|
$networkname = "chaos";
|
||
|
|
$tincd_bin = "/usr/sbin/tincd";
|
||
|
|
$ip_bin = "/sbin/ip";
|
||
|
|
$ifconfig = "/sbin/ifconfig \$INTERFACE $my_vpn_ip netmask $my_vpn_netmask";
|
||
|
|
$ifconfig6 = "$ip_bin addr add $my_vpn_ip6/128 dev \$INTERFACE";
|
||
|
|
|
||
|
|
$master_url = "https://www.vpn.hamburg.ccc.de/tinc-chaosvpn.txt";
|
||
|
|
$base = "/etc/tinc/$networkname";
|
||
|
|
$pidfile = "/var/run/tinc.$networkname.pid";
|
||
|
|
$tincd_debuglevel = 3;
|
||
|
|
|
||
|
|
|
||
|
|
# config einlesen
|
||
|
|
require $config;
|
||
|
|
|
||
|
|
if (!-e "/dev/net/tun") {
|
||
|
|
warn "/dev/net/tun missing - creating it";
|
||
|
|
system("mkdir", "-p", "/dev/net") && die;
|
||
|
|
system("mknod", "-m", "0600", "/dev/net/tun", "c", "10", "200") && die;
|
||
|
|
}
|
||
|
|
|
||
|
|
my $answer = call_out_to_server();
|
||
|
|
my $peers;
|
||
|
|
if ($answer) {
|
||
|
|
#print $answer;
|
||
|
|
$peers = parse_server_answer($answer);
|
||
|
|
#print Dumper($peers);
|
||
|
|
} else {
|
||
|
|
#die "we lost";
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($peers) {
|
||
|
|
# wir haben eine neue config bekommen
|
||
|
|
|
||
|
|
eval {
|
||
|
|
create_config($peers);
|
||
|
|
};
|
||
|
|
if ($@) {
|
||
|
|
warn $@;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# alten daemon beenden
|
||
|
|
if (-e $pidfile) {
|
||
|
|
# get pid
|
||
|
|
open(PIDFILE, "<$pidfile") || die "read error on pidfile $pidfile\n";
|
||
|
|
my $pid = <PIDFILE>;
|
||
|
|
chomp $pid;
|
||
|
|
close(PIDFILE);
|
||
|
|
|
||
|
|
if (($pid =~ /^\d+$/) && (kill(0, $pid))) {
|
||
|
|
# prozess existiert, abschiessen
|
||
|
|
kill "TERM", $pid;
|
||
|
|
|
||
|
|
my $c;
|
||
|
|
for ($c = 0; $c < 20; $c++) {
|
||
|
|
# wir wollen nicht laenger als unbedingt
|
||
|
|
# noetig warten, aber max 2sek
|
||
|
|
|
||
|
|
select(undef, undef, undef, 0.1); # sleep 100ms
|
||
|
|
last unless kill(0, $pid);
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($c >= 20) {
|
||
|
|
# existiert noch immer, do it the hard way
|
||
|
|
# ist noetig wenn der tincd vorher probleme mit
|
||
|
|
# seiner config hatte, dann reicht ein SIGTERM
|
||
|
|
# nicht aus
|
||
|
|
|
||
|
|
kill "KILL", $pid;
|
||
|
|
select(undef, undef, undef, 0.1); # sleep 100ms
|
||
|
|
}
|
||
|
|
|
||
|
|
if (kill(0, $pid)) {
|
||
|
|
# immer noch? da iss was fischig
|
||
|
|
die "can't kill old tincd with pid $pid\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
# try it the old fashioned way, may not work
|
||
|
|
system($tincd_bin, "-n", $networkname, "-k") || sleep 1;
|
||
|
|
}
|
||
|
|
# neuen daemon starten
|
||
|
|
system($tincd_bin, "-n", $networkname, "--debug", $tincd_debuglevel) && die;
|
||
|
|
|
||
|
|
exit(0);
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
sub call_out_to_server
|
||
|
|
{
|
||
|
|
my $ua = new LWP::UserAgent;
|
||
|
|
$ua->agent("ChaosVPNclient/0.1");
|
||
|
|
|
||
|
|
my $params = "id=" . CGI::escape($my_peerid) .
|
||
|
|
"&password=" . CGI::escape($my_password) .
|
||
|
|
"&ip=" . CGI::escape($my_ip);
|
||
|
|
|
||
|
|
#my $req = HTTP::Request->new(POST => $master_url);
|
||
|
|
#$req->content_type("application/x-www-form-urlencoded");
|
||
|
|
#$req->content($params);
|
||
|
|
|
||
|
|
# testmode:
|
||
|
|
my $req = HTTP::Request->new(GET => "$master_url?$params");
|
||
|
|
|
||
|
|
my $res = $ua->request($req);
|
||
|
|
|
||
|
|
if ($res->is_success) {
|
||
|
|
my $answer = $res->content;
|
||
|
|
return $answer;
|
||
|
|
} else {
|
||
|
|
#print Dumper($res);
|
||
|
|
warn "Warning: " . $res->status_line() . "\n";
|
||
|
|
return undef;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
sub parse_server_answer($)
|
||
|
|
{
|
||
|
|
my ($answer) = @_;
|
||
|
|
my $peers = {};
|
||
|
|
|
||
|
|
my $current_peer = undef;
|
||
|
|
my $peer = {};
|
||
|
|
my $in_key = 0;
|
||
|
|
|
||
|
|
foreach (split(/\n/, $answer)) {
|
||
|
|
#print "debug: $_\n";
|
||
|
|
|
||
|
|
s/\#.*$//;
|
||
|
|
|
||
|
|
if (/^\s*\[(.*?)\]\s*$/) {
|
||
|
|
if ($current_peer) {
|
||
|
|
$peers->{$current_peer} = $peer;
|
||
|
|
}
|
||
|
|
$peer = {
|
||
|
|
"use-tcp-only" => 0,
|
||
|
|
"hidden" => 0,
|
||
|
|
"silent" => 0,
|
||
|
|
"port" => 655,
|
||
|
|
};
|
||
|
|
$current_peer = $1;
|
||
|
|
$current_peer = undef unless ($current_peer =~ /^[a-z0-9]+$/);
|
||
|
|
$in_key = 0;
|
||
|
|
} elsif ($current_peer) {
|
||
|
|
if ($in_key) {
|
||
|
|
$peer->{pubkey} .= $_;
|
||
|
|
$peer->{pubkey} .= "\n";
|
||
|
|
|
||
|
|
$in_key = 0
|
||
|
|
if (/^-----END RSA PUBLIC KEY-----/);
|
||
|
|
} elsif (/^\s*gatewayhost=(.*)$\s*/i) {
|
||
|
|
$peer->{gatewayhost} = $1;
|
||
|
|
} elsif (/^\s*owner=(.*)$\s*/i) {
|
||
|
|
$peer->{owner} = $1;
|
||
|
|
} elsif (/^\s*use-tcp-only=(.*)$\s*/i) {
|
||
|
|
$peer->{"use-tcp-only"} = $1;
|
||
|
|
} elsif (/^\s*network=(.*)\s*$/i) {
|
||
|
|
push @{$peer->{networks}}, $1;
|
||
|
|
} elsif (/^\s*network6=(.*)\s*$/i) {
|
||
|
|
push @{$peer->{networks6}}, $1;
|
||
|
|
} elsif (/^\s*hidden=(.*)\s*$/i) {
|
||
|
|
$peer->{hidden} = $1;
|
||
|
|
} elsif (/^\s*silent=(.*)\s*$/i) {
|
||
|
|
$peer->{silent} = $1;
|
||
|
|
} elsif (/^\s*port=(.*)\s*$/i) {
|
||
|
|
$peer->{port} = $1;
|
||
|
|
} elsif (/^-----BEGIN RSA PUBLIC KEY-----/) {
|
||
|
|
$in_key = 1;
|
||
|
|
$peer->{pubkey} = $_ . "\n";
|
||
|
|
}
|
||
|
|
} elsif (/^\s*$/ || /^\s*\#/) {
|
||
|
|
# ignore empty lines or comments
|
||
|
|
} else {
|
||
|
|
warn "unknown line: $_\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# den letzten, noch offenen, peer auch in der struktur verankern
|
||
|
|
if ($current_peer) {
|
||
|
|
$peers->{$current_peer} = $peer;
|
||
|
|
}
|
||
|
|
|
||
|
|
return $peers;
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
sub create_config($)
|
||
|
|
{
|
||
|
|
my ($peers) = @_;
|
||
|
|
|
||
|
|
if (!-e "$base.first") {
|
||
|
|
system("cp", "-r", "$base", "$base.first") && die;
|
||
|
|
}
|
||
|
|
|
||
|
|
if (-e "$base.new") {
|
||
|
|
system("rm", "-r", "$base.new") && die;
|
||
|
|
}
|
||
|
|
if (-e "$base.old") {
|
||
|
|
system("rm", "-r", "$base.old") && die;
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
system("mkdir", "-p", "$base.new") && die;
|
||
|
|
system("mkdir", "-p", "$base.new/hosts") && die;
|
||
|
|
system("cp", "$base/rsa_key.priv", "$base.new/rsa_key.priv") && die;
|
||
|
|
chmod(0600, "$base.new/rsa_key.priv") || die;
|
||
|
|
system("cp", "$base/rsa_key.pub", "$base.new/rsa_key.pub") && die;
|
||
|
|
chmod(0600, "$base.new/rsa_key.pub") || die;
|
||
|
|
|
||
|
|
# base config file erzeugen
|
||
|
|
open(MAIN, ">$base.new/tinc.conf") || die "create tinc.conf failed";
|
||
|
|
print MAIN "AddressFamily=ipv4\n";
|
||
|
|
print MAIN "Device=/dev/net/tun\n";
|
||
|
|
print MAIN "Interface=${networkname}_vpn\n";
|
||
|
|
print MAIN "Mode=router\n";
|
||
|
|
print MAIN "Name=$my_peerid\n";
|
||
|
|
print MAIN "Hostnames=yes\n"; # unsure about this
|
||
|
|
|
||
|
|
open(UP, ">$base.new/tinc-up") || die "create tinc-up failed";
|
||
|
|
print UP "#!/bin/sh\n";
|
||
|
|
print UP $ifconfig, "\n" if ($my_vpn_ip);
|
||
|
|
print UP $ifconfig6, "\n" if ($my_vpn_ip6);
|
||
|
|
|
||
|
|
PEERS: foreach my $id (keys %$peers) {
|
||
|
|
my $peer = $peers->{$id};
|
||
|
|
foreach (@exclude) {
|
||
|
|
if ($id eq $_) {
|
||
|
|
print "peer: $id -- excluded\n";
|
||
|
|
next PEERS;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
print "peer: $id\n", Dumper($peer);
|
||
|
|
|
||
|
|
open(PEER, ">$base.new/hosts/$id") || die "create hosts/$id failed";
|
||
|
|
print PEER "Address=$peer->{gatewayhost}\n"
|
||
|
|
if ($peer->{gatewayhost});
|
||
|
|
print PEER "Cipher=blowfish\n";
|
||
|
|
print PEER "Compression=0\n";
|
||
|
|
print PEER "Digest=sha1\n";
|
||
|
|
print PEER "IndirectData=yes\n";
|
||
|
|
print PEER "Port=$peer->{port}\n";
|
||
|
|
|
||
|
|
if ($my_vpn_ip) {
|
||
|
|
foreach (@{$peer->{networks}}) {
|
||
|
|
print PEER "Subnet=$_\n";
|
||
|
|
print UP "$ip_bin -4 route add $_ dev \$INTERFACE\n"
|
||
|
|
if ($id ne $my_peerid);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($my_vpn_ip6) {
|
||
|
|
foreach (@{$peer->{networks6}}) {
|
||
|
|
print PEER "Subnet=$_\n";
|
||
|
|
print UP "$ip_bin -6 route add $_ dev \$INTERFACE\n"
|
||
|
|
if ($id ne $my_peerid);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
print PEER "TCPonly=", ($peer->{"use-tcp-only"} ? "yes" : "no");
|
||
|
|
print PEER "\n";
|
||
|
|
|
||
|
|
print PEER $peer->{pubkey}, "\n";
|
||
|
|
|
||
|
|
close(PEER) || die "write error hosts/$id";
|
||
|
|
|
||
|
|
if ($id ne $my_peerid) {
|
||
|
|
# den rest nur fuer die anderen hosts
|
||
|
|
|
||
|
|
if ($peer->{gatewayhost} && !$peers->{hidden} && !$peers->{$my_peerid}->{silent}) {
|
||
|
|
print MAIN "ConnectTo=$id\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
if (-e "$base/hosts/$id-up") {
|
||
|
|
system("cp", "$base/hosts/$id-up", "$base.new/hosts/$id-up") && die;
|
||
|
|
}
|
||
|
|
if (-e "$base/hosts/$id-down") {
|
||
|
|
system("cp", "$base/hosts/$id-down", "$base.new/hosts/$id-down") && die;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
close(MAIN) || die "write error tinc.conf";
|
||
|
|
|
||
|
|
close(UP) || die "write error tinc-up";
|
||
|
|
system("chmod", "0700", "$base.new/tinc-up") && die;
|
||
|
|
|
||
|
|
system("mv", "$base", "$base.old") && die;
|
||
|
|
system("mv", "$base.new", "$base") && die;
|
||
|
|
|
||
|
|
return 1;
|
||
|
|
}
|