脚本之家,脚本语言编程技术及教程分享平台!
分类导航

Python|VBS|Ruby|Lua|perl|VBA|Golang|PowerShell|Erlang|autoit|Dos|bat|

服务器之家 - 脚本之家 - perl - Perl实现的Linux下socket代理服务器

Perl实现的Linux下socket代理服务器

2020-06-19 10:37脚本之家 perl

这篇文章主要介绍了Perl实现的Linux下socket代理服务器,比较简洁的一个版本,需要的朋友可以参考下

大家提供了许多linux开代理的方法,一般用到python等语言,一些服务器可能不会安装,然而perl可以说是linux标配的语言,给大家一款Perl语言的socket代理,代码非常少,而且还支持密码,效果还是不错,感觉很稳定。

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
#!/usr/bin/perl
 
$auth_enabled = 0;
$auth_login = "hidden";
$auth_pass = "hidden";
$port = 44269;
 
use IO::Socket::INET;
 
$SIG{'CHLD'} = 'IGNORE';
$bind = IO::Socket::INET->new(Listen=>10, Reuse=>1, LocalPort=>$port) or die "Нельзя забиндить порт $port\n";
 
while($client = $bind->accept()) {
$client->autoflush();
 
if(fork()){ $client->close(); }
else { $bind->close(); new_client($client); exit(); }
}
 
sub new_client {
local $t, $i, $buff, $ord, $success;
local $client = $_[0];
sysread($client, $buff, 1);
 
if(ord($buff) == 5) {
 sysread($client, $buff, 1);
 $t = ord($buff);
 
 unless(sysread($client, $buff, $t) == $t) { return; }
 
 $success = 0;
 for($i = 0; $i < $t; $i++) {
 $ord = ord(substr($buff, $i, 1));
 if($ord == 0 && !$auth_enabled) {
  syswrite($client, "\x05\x00", 2);
  $success++;
  break;
 }
 elsif($ord == 2 && $auth_enabled) {
  unless(do_auth($client)){ return; }
  $success++;
  break;
 }
 }
 
 if($success) {
 $t = sysread($client, $buff, 3);
 
 if(substr($buff, 0, 1) == '\x05') {
  if(ord(substr($buff, 2, 1)) == 0) {
  ($host, $raw_host) = socks_get_host($client);
  if(!$host) { return; }
  ($port, $raw_port) = socks_get_port($client);
  if(!$port) { return; }
  $ord = ord(substr($buff, 1, 1));
  $buff = "\x05\x00\x00".$raw_host.$raw_port;
  syswrite($client, $buff, length($buff));
  socks_do($ord, $client, $host, $port);
  }
 }
 } else { syswrite($client, "\x05\xFF", 2); };
}
$client->close();
}
 
sub do_auth {
local $buff, $login, $pass;
local $client = $_[0];
 
syswrite($client, "\x05\x02", 2);
sysread($client, $buff, 1);
 
if(ord($buff) == 1) {
 sysread($client, $buff, 1);
 sysread($client, $login, ord($buff));
 sysread($client, $buff, 1);
 sysread($client, $pass, ord($buff));
 
 if($login eq $auth_login && $pass eq $auth_pass) {
 syswrite($client, "\x05\x00", 2);
 return 1;
 } else { syswrite($client, "\x05\x01", 2); }
}
 
$client->close();
return 0;
}
 
sub socks_get_host {
local $client = $_[0];
local $t, $ord, $raw_host;
local $host = "";
 
sysread($client, $t, 1);
$ord = ord($t);
if($ord == 1) {
 sysread($client, $raw_host, 4);
 @host = $raw_host =~ /(.)/g;
 $host = ord($host[0]).".".ord($host[1]).".".ord($host[2]).".".ord($host[3]);
} elsif($ord == 3) {
 sysread($client, $raw_host, 1);
 sysread($client, $host, ord($raw_host));
 $raw_host .= $host;
} elsif($ord == 4) {
 #ipv6 - not supported
}
 
return ($host, $t.$raw_host);
}
 
sub socks_get_port {
local $client = $_[0];
local $raw_port, $port;
sysread($client, $raw_port, 2);
$port = ord(substr($raw_port, 0, 1)) << 8 | ord(substr($raw_port, 1, 1));
return ($port, $raw_port);
}
 
sub socks_do {
local($t, $client, $host, $port) = @_;
 
if($t == 1) { socks_connect($client, $host, $port); }
elsif($t == 2) { socks_bind($client, $host, $port); }
elsif($t == 3) { socks_udp_associate($client, $host, $port); }
else { return 0; }
 
return 1;
}
 
sub socks_connect {
my($client, $host, $port) = @_;
my $target = IO::Socket::INET->new(PeerAddr => $host, PeerPort => $port, Proto => 'tcp', Type => SOCK_STREAM);
 
unless($target) { return; }
 
$target->autoflush();
while($client || $target) {
 my $rin = "";
 vec($rin, fileno($client), 1) = 1 if $client;
 vec($rin, fileno($target), 1) = 1 if $target;
 my($rout, $eout);
 select($rout = $rin, undef, $eout = $rin, 120);
 if (!$rout && !$eout) { return; }
 my $cbuffer = "";
 my $tbuffer = "";
 
 if ($client && (vec($eout, fileno($client), 1) || vec($rout, fileno($client), 1))) {
 my $result = sysread($client, $tbuffer, 1024);
 if (!defined($result) || !$result) { return; }
 }
 
 if ($target && (vec($eout, fileno($target), 1) || vec($rout, fileno($target), 1))) {
 my $result = sysread($target, $cbuffer, 1024);
 if (!defined($result) || !$result) { return; }
 }
 
 if ($fh && $tbuffer) { print $fh $tbuffer; }
 
 while (my $len = length($tbuffer)) {
 my $res = syswrite($target, $tbuffer, $len);
 if ($res > 0) { $tbuffer = substr($tbuffer, $res); } else { return; }
 }
 
 while (my $len = length($cbuffer)) {
 my $res = syswrite($client, $cbuffer, $len);
 if ($res > 0) { $cbuffer = substr($cbuffer, $res); } else { return; }
 }
}
}
 
sub socks_bind {
my($client, $host, $port) = @_;
}
 
sub socks_udp_associate {
my($client, $host, $port) = @_;
}

延伸 · 阅读

精彩推荐
  • perlperl use vars pragma使用技巧

    perl use vars pragma使用技巧

    perl 中的vars是perl中的一个pragma(预编译指示符),专门用来预定义全局变量,这些预定义后的全局变量在qw()列表中,在整个引用perl文件中皆可使用,即便使...

    perl教程网6812020-06-16
  • perlperl常见问题集合之二

    perl常见问题集合之二

    哪些平台上有 Perl?要到哪里去找? Perl的标准发行版(由 perl 发展小组负责维护)仅以原始码形式发行。您可在 http: //www.perl.com/CPAN/src/latest.tar.gz处取得。这个档...

    脚本之家2102020-05-29
  • perlperl pop push shift unshift实例介绍

    perl pop push shift unshift实例介绍

    perl的pop跟push操作数组的最右边,shift跟unshift操作数组的最左边 ...

    脚本之家4612020-06-10
  • perlperl命令行参数内建数组@ARGV浅析

    perl命令行参数内建数组@ARGV浅析

    这篇文章主要介绍了perl命令行参数内建数组@ARGV浅析,本文重点在于讲解@ARGV的用法,并通过实例来说明,需要的朋友可以参考下 ...

    perl教程网6162020-06-18
  • perlPerl List::Util模块使用实例

    Perl List::Util模块使用实例

    这篇文章主要介绍了Perl List::Util模块使用实例,本文给出扫描符合条件的某个列表并取出第一个符合条件的、求1到1000之间的和 、求一组数字的最大值与最小...

    脚本之家4712020-06-22
  • perlPerl使用nginx FastCGI环境做WEB开发实例

    Perl使用nginx FastCGI环境做WEB开发实例

    这篇文章主要介绍了Perl使用nginx FastCGI环境做WEB开发实例,实现了路由系统和模板系统,需要的朋友可以参考下...

    Perl教程网2412020-06-18
  • perlPerl从文件中读取字符串的两种实现方法

    Perl从文件中读取字符串的两种实现方法

    有时候我们需要从文件中读取字符串,这里简单介绍下, 需要的朋友可以参考下 ...

    脚本之家6252020-06-08
  • perlPerl的经典用法分享

    Perl的经典用法分享

    Perl的经典用法分享,学习perl的朋友可以参考下 ...

    脚本之家6562020-06-06