Perl实现花生壳DDNS客户端［2013/01/03更新］

ttcn_cu

参考@coolend兄的帖子：http://bbs.chinaunix.net/thread-1825007-1-1.html
修正了64位系统下Perl的兼容性问题
修正了最后没有confirm的问题（花生壳协议更新）
修正了一定几率提交失败的问题（花生壳的文档里加密串ror没有提到的一个暗雷）
打算用它结合树莓派搭建一个git服务器

有花生壳的朋友可以试试。

1. #!/usr/bin/perl
   
2. 
   
3. use strict;
   
4. use IO::Socket::INET;
   
5. use MIME::Base64 qw(encode_base64 decode_base64);
   
6. use Digest::HMAC_MD5 qw(hmac_md5);
   
7. my $serverip = "ph051.oray.net";
   
8. my $port = '6060';
   
9. 
   
10. ###  登录用户名和密码
    
11. my $user = '花生壳账户';
    
12. my $pass =  '密码';
    
13. my $domain ='花生壳域名.xicp.net';
    
14. 
    
15. 
    
16. 
    
17. my $sock = IO::Socket::INET->new(
    
18.     PeerAddr => $serverip,
    
19.     PeerPort => $port,
    
20.     Proto    => 'tcp',
    
21. ) or die "ERR: unable to connect to server $! \n";
    
22. 
    
23. my $msg;
    
24. $sock->recv($msg,128);
    
25. die "ERR: server not response ! \n" if (! $msg);
    
26. print $msg;
    
27. 
    
28. ## 发送验证请求
    
29. print $sock "auth router6\n";
    
30. $sock->recv($msg,128);
    
31. print $msg;
    
32. 
    
33. ## BASE64 解码
    
34. $msg =~ s/^\d+\s+//;
    
35. my $reply = decode_base64($msg);
    
36. 
    
37. print "Reply message content is: ",unpack("H*",$reply),"\n";
    
38. 
    
39. ## 服务器时间是挑战串的第六字节后的4个字节
    
40. my $stime = substr($reply,6,4);
    
41. my $tm_stime = unpack("H*",$stime);
    
42. $tm_stime =~ s/^(\w{2})(\w{2})(\w{2})(\w{2})$/$4$3$2$1/;
    
43. $tm_stime = hex($tm_stime);
    
44. 
    
45. ## 打印下服务器的时间，便于调试
    
46. print "Server time is $tm_stime, ",&timenow($tm_stime),"\n";
    
47. 
    
48. ### 以下信息从 “笑行天下” 的 DDNS代码中借用的
    
49. my $client_ID = "0x26A0";   # 客户端ID
    
50. my $client_VER = "0x9899"; # 客户端版本
    
51. my $auth_KEY = "0x1E0808B7"; # 嵌入认证密码
    
52. 
    
53. ### 客户端信息为客户端ID＋版本号，共4字节
    
54. my $client_info = ((hex($client_ID) & 0xFFFF) << 16) | (hex($client_VER) & 0xFFFF);
    
55. 
    
56. ## 转换为16进制
    
57. $client_info = sprintf ("%x",$client_info);
    
58. $client_info =~ s/^(\w{2})(\w{2})(\w{2})(\w{2})$/$4$3$2$1/;
    
59. 
    
60. print "Client INFO: $client_info\n";
    
61. my $auth_key = hex($auth_KEY);
    
62. ## 嵌入认证码与时间的取反进行或运算后循环右移
    
63. $tm_stime = $tm_stime | (~$auth_key)&0xFFFFFFFF;
    
64. printf ("%032b \n",$tm_stime);
    
65. print "Positive: $tm_stime\n";
    
66. ### 右移位数是用服务器时间整除30后的余数
    
67. my $mv = $tm_stime % 30;
    
68. print "Original Movebit: $mv\n";
    
69. $mv+=2 if $mv>16;  ####暗雷
    
70. print "Adjusted Movebit: $mv\n";
    
71. my $auth_enc=ror($tm_stime,($mv),32);
    
72. $auth_enc &= 0xFFFFFFFF;
    
73. printf ("%032b\n",$auth_enc);
    
74. $auth_enc &= 0xFFFFFFFF;
    
75. $auth_enc = sprintf ("%x",$auth_enc);
    
76. $auth_enc =~ s/^(\w{2})(\w{2})(\w{2})(\w{2})$/$2$1$4$3/;
    
77. print "AUTH_ENC: $auth_enc\n";
    
78. 
    
79. ## 加密串
    
80. my $enc_str = unpack("H*",hmac_md5($pass, $reply));
    
81. print "ENC STR: $enc_str\n";
    
82. 
    
83. my $header = pack("H*","$auth_enc$client_info$enc_str");
    
84. print "HEADER: " . unpack("H*",$header) , " LEN: " , length($header),"\n";
    
85. 
    
86. ## 生成回应串用BASE64编码
    
87. my $lines = join('',$user,' ',$header);
    
88. my $base64 = encode_base64 $lines;
    
89. print "Send BASE64: $base64\n";
    
90. 
    
91. ### 发送给服务端
    
92. print $sock "$base64\n";
    
93. $sock->recv($msg,128);
    
94. print $msg;
    
95. 
    
96. ### 注册域名
    
97. print $sock "regi a $domain\n";
    
98. $sock->recv($msg,128);
    
99. print $msg;
    
100. ### 确认
     
101. print $sock "cnfm\n";
     
102. $sock->recv($msg,128);
     
103. print $msg;
     
104. 
     
105. 
     
106. ## 退出
     
107. print $sock "quit\n";
     
108. 
     
109. $sock->shutdown(1);
     
110. $sock->close();
     
111. 
     
112. sub rol { return ($_[0]<<$_[1] | $_[0]>>($_[2]-$_[1])) & (2**$_[2]-1); }
     
113. sub ror { return ($_[0]>>$_[1] | $_[0]<<($_[2]-$_[1])) & (2**$_[2]-1); }
     
114. sub timenow {
     
115.     my $tm = time();
     
116.     my ($sec,$min,$hur,$day,$mon,$year) = (localtime($tm))[0,1,2,3,4,5];
     
117.     $year += 1900; ++ $mon ;
     
118.     return sprintf ("%02u-%02u-%02u %02u:%02u:%02u",$year,$mon,$day,$hur,$min,$sec);
     
119. }
     

复制代码

wxlfh

不错，学习了。

兰花仙子

谢谢 有空试试 鼓励原创

flw

能稍微模块化一下就更好了。

fengyun530

树莓派的机器性能对于一个20几人的团队操作的情况下，其内存性能能承受得住吗？

ttcn_cu

回复 5# fengyun530

512 内存的机器,我不清楚,应该不行吧.我只是把它当个人使用的玩具而已.
你有20个人的团队还是正正经经的投资一个靠谱的设备,多考虑备份容灾
   

dingonet

花生壳才那么麻烦的吧?看看3322.org的就简单很多了..
lynx -mime_header -auth=UserNameassword 'http://members.3322.net/dyndns/update?system=dyndns&hostname=domainname'

coolend

ttcn_cu 发表于 2013-01-03 17:32
参考@coolend兄的帖子：http://bbs.chinaunix.net/thread-1825007-1-1.html
修正了64位系统下Perl的兼容性 ...

呵呵~~~ 想不到2年前的帖子还有人关注

花生壳的协议的确搞的太复杂了，BS一个... 之前用perl来实现主要是因为它提供的二进制的客户端太难用了，不过目前官网已经提供C的源代码了

另外有个地方需要注意：

客户端发送 auth router6 命令后，服务器端可能返回  536 Should Redirection To <phddns60std.oray.net> 这样的重定向信息（针对花生壳的付费用户），
需重新和新的服务器建立连接，否则后面的命令将无效。

LZ打算用RPI建GIT服务器? 推荐使用 gitolite（perl写的），偶们公司开始用的gitosis(基于python），后来换成了gitolite，很好用！

ttcn_cu

回复 8# coolend


    感谢你提供代码！我也是编一个binary没编过去才想到搜perl代码的，没想到一搜就搜到CU了。我现在临时用GitStack（在Windows笔记本上装的）和GitLab。等有了想法再试试Git on Perl,应该可以写出一些提高效率的插件 吼吼。

starggw

不错哦，DDNS在系统运维中用处很多的