2
0

ftp.pm 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398
  1. #***************************************************************************
  2. # _ _ ____ _
  3. # Project ___| | | | _ \| |
  4. # / __| | | | |_) | |
  5. # | (__| |_| | _ <| |___
  6. # \___|\___/|_| \_\_____|
  7. #
  8. # Copyright (C) 1998 - 2020, Daniel Stenberg, <daniel@haxx.se>, et al.
  9. #
  10. # This software is licensed as described in the file COPYING, which
  11. # you should have received as part of this distribution. The terms
  12. # are also available at https://curl.se/docs/copyright.html.
  13. #
  14. # You may opt to use, copy, modify, merge, publish, distribute and/or sell
  15. # copies of the Software, and permit persons to whom the Software is
  16. # furnished to do so, under the terms of the COPYING file.
  17. #
  18. # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
  19. # KIND, either express or implied.
  20. #
  21. ###########################################################################
  22. BEGIN {
  23. # portable sleeping needs Time::HiRes
  24. eval {
  25. no warnings "all";
  26. require Time::HiRes;
  27. };
  28. # portable sleeping falls back to native Sleep on Win32
  29. eval {
  30. no warnings "all";
  31. require Win32;
  32. }
  33. }
  34. use strict;
  35. use warnings;
  36. use serverhelp qw(
  37. servername_id
  38. mainsockf_pidfilename
  39. datasockf_pidfilename
  40. );
  41. use pathhelp qw(
  42. os_is_win
  43. );
  44. #######################################################################
  45. # portable_sleep uses Time::HiRes::sleep if available and falls back
  46. # to the classic approach of using select(undef, undef, undef, ...).
  47. # even though that one is not portable due to being implemented using
  48. # select on Windows: https://perldoc.perl.org/perlport.html#select
  49. # Therefore it uses Win32::Sleep on Windows systems instead.
  50. #
  51. sub portable_sleep {
  52. my ($seconds) = @_;
  53. if($Time::HiRes::VERSION) {
  54. Time::HiRes::sleep($seconds);
  55. }
  56. elsif (os_is_win()) {
  57. Win32::Sleep($seconds*1000);
  58. }
  59. else {
  60. select(undef, undef, undef, $seconds);
  61. }
  62. }
  63. #######################################################################
  64. # pidfromfile returns the pid stored in the given pidfile. The value
  65. # of the returned pid will never be a negative value. It will be zero
  66. # on any file related error or if a pid can not be extracted from the
  67. # given file.
  68. #
  69. sub pidfromfile {
  70. my $pidfile = $_[0];
  71. my $pid = 0;
  72. if(-f $pidfile && -s $pidfile && open(PIDFH, "<$pidfile")) {
  73. $pid = 0 + <PIDFH>;
  74. close(PIDFH);
  75. $pid = 0 unless($pid > 0);
  76. }
  77. return $pid;
  78. }
  79. #######################################################################
  80. # pidexists checks if a process with a given pid exists and is alive.
  81. # This will return the positive pid if the process exists and is alive.
  82. # This will return the negative pid if the process exists differently.
  83. # This will return 0 if the process could not be found.
  84. #
  85. sub pidexists {
  86. my $pid = $_[0];
  87. if($pid > 0) {
  88. # verify if currently existing Windows process
  89. if ($pid > 65536 && os_is_win()) {
  90. $pid -= 65536;
  91. if($^O ne 'MSWin32') {
  92. my $filter = "PID eq $pid";
  93. my $result = `tasklist -fi \"$filter\" 2>nul`;
  94. if(index($result, "$pid") != -1) {
  95. return -$pid;
  96. }
  97. return 0;
  98. }
  99. }
  100. # verify if currently existing and alive
  101. if(kill(0, $pid)) {
  102. return $pid;
  103. }
  104. }
  105. return 0;
  106. }
  107. #######################################################################
  108. # pidterm asks the process with a given pid to terminate gracefully.
  109. #
  110. sub pidterm {
  111. my $pid = $_[0];
  112. if($pid > 0) {
  113. # request the process to quit
  114. if ($pid > 65536 && os_is_win()) {
  115. $pid -= 65536;
  116. if($^O ne 'MSWin32') {
  117. my $filter = "PID eq $pid";
  118. my $result = `tasklist -fi \"$filter\" 2>nul`;
  119. if(index($result, "$pid") != -1) {
  120. system("taskkill -fi \"$filter\" >nul 2>&1");
  121. }
  122. return;
  123. }
  124. }
  125. # signal the process to terminate
  126. kill("TERM", $pid);
  127. }
  128. }
  129. #######################################################################
  130. # pidkill kills the process with a given pid mercilessly and forcefully.
  131. #
  132. sub pidkill {
  133. my $pid = $_[0];
  134. if($pid > 0) {
  135. # request the process to quit
  136. if ($pid > 65536 && os_is_win()) {
  137. $pid -= 65536;
  138. if($^O ne 'MSWin32') {
  139. my $filter = "PID eq $pid";
  140. my $result = `tasklist -fi \"$filter\" 2>nul`;
  141. if(index($result, "$pid") != -1) {
  142. system("taskkill -f -fi \"$filter\" >nul 2>&1");
  143. # Windows XP Home compatibility
  144. system("tskill $pid >nul 2>&1");
  145. }
  146. return;
  147. }
  148. }
  149. # signal the process to terminate
  150. kill("KILL", $pid);
  151. }
  152. }
  153. #######################################################################
  154. # pidwait waits for the process with a given pid to be terminated.
  155. #
  156. sub pidwait {
  157. my $pid = $_[0];
  158. my $flags = $_[1];
  159. # check if the process exists
  160. if ($pid > 65536 && os_is_win()) {
  161. if($flags == &WNOHANG) {
  162. return pidexists($pid)?0:$pid;
  163. }
  164. while(pidexists($pid)) {
  165. portable_sleep(0.01);
  166. }
  167. return $pid;
  168. }
  169. # wait on the process to terminate
  170. return waitpid($pid, $flags);
  171. }
  172. #######################################################################
  173. # processexists checks if a process with the pid stored in the given
  174. # pidfile exists and is alive. This will return 0 on any file related
  175. # error or if a pid can not be extracted from the given file. When a
  176. # process with the same pid as the one extracted from the given file
  177. # is currently alive this returns that positive pid. Otherwise, when
  178. # the process is not alive, will return the negative value of the pid.
  179. #
  180. sub processexists {
  181. use POSIX ":sys_wait_h";
  182. my $pidfile = $_[0];
  183. # fetch pid from pidfile
  184. my $pid = pidfromfile($pidfile);
  185. if($pid > 0) {
  186. # verify if currently alive
  187. if(pidexists($pid)) {
  188. return $pid;
  189. }
  190. else {
  191. # get rid of the certainly invalid pidfile
  192. unlink($pidfile) if($pid == pidfromfile($pidfile));
  193. # reap its dead children, if not done yet
  194. pidwait($pid, &WNOHANG);
  195. # negative return value means dead process
  196. return -$pid;
  197. }
  198. }
  199. return 0;
  200. }
  201. #######################################################################
  202. # killpid attempts to gracefully stop processes in the given pid list
  203. # with a SIGTERM signal and SIGKILLs those which haven't died on time.
  204. #
  205. sub killpid {
  206. use POSIX ":sys_wait_h";
  207. my ($verbose, $pidlist) = @_;
  208. my @requested;
  209. my @signalled;
  210. my @reapchild;
  211. # The 'pidlist' argument is a string of whitespace separated pids.
  212. return if(not defined($pidlist));
  213. # Make 'requested' hold the non-duplicate pids from 'pidlist'.
  214. @requested = split(' ', $pidlist);
  215. return if(not @requested);
  216. if(scalar(@requested) > 2) {
  217. @requested = sort({$a <=> $b} @requested);
  218. }
  219. for(my $i = scalar(@requested) - 2; $i >= 0; $i--) {
  220. if($requested[$i] == $requested[$i+1]) {
  221. splice @requested, $i+1, 1;
  222. }
  223. }
  224. # Send a SIGTERM to processes which are alive to gracefully stop them.
  225. foreach my $tmp (@requested) {
  226. chomp $tmp;
  227. if($tmp =~ /^(\d+)$/) {
  228. my $pid = $1;
  229. if($pid > 0) {
  230. if(pidexists($pid)) {
  231. print("RUN: Process with pid $pid signalled to die\n")
  232. if($verbose);
  233. pidterm($pid);
  234. push @signalled, $pid;
  235. }
  236. else {
  237. print("RUN: Process with pid $pid already dead\n")
  238. if($verbose);
  239. # if possible reap its dead children
  240. pidwait($pid, &WNOHANG);
  241. push @reapchild, $pid;
  242. }
  243. }
  244. }
  245. }
  246. # Allow all signalled processes five seconds to gracefully die.
  247. if(@signalled) {
  248. my $twentieths = 5 * 20;
  249. while($twentieths--) {
  250. for(my $i = scalar(@signalled) - 1; $i >= 0; $i--) {
  251. my $pid = $signalled[$i];
  252. if(!pidexists($pid)) {
  253. print("RUN: Process with pid $pid gracefully died\n")
  254. if($verbose);
  255. splice @signalled, $i, 1;
  256. # if possible reap its dead children
  257. pidwait($pid, &WNOHANG);
  258. push @reapchild, $pid;
  259. }
  260. }
  261. last if(not scalar(@signalled));
  262. portable_sleep(0.05);
  263. }
  264. }
  265. # Mercilessly SIGKILL processes still alive.
  266. if(@signalled) {
  267. foreach my $pid (@signalled) {
  268. if($pid > 0) {
  269. print("RUN: Process with pid $pid forced to die with SIGKILL\n")
  270. if($verbose);
  271. pidkill($pid);
  272. # if possible reap its dead children
  273. pidwait($pid, &WNOHANG);
  274. push @reapchild, $pid;
  275. }
  276. }
  277. }
  278. # Reap processes dead children for sure.
  279. if(@reapchild) {
  280. foreach my $pid (@reapchild) {
  281. if($pid > 0) {
  282. pidwait($pid, 0);
  283. }
  284. }
  285. }
  286. }
  287. #######################################################################
  288. # killsockfilters kills sockfilter processes for a given server.
  289. #
  290. sub killsockfilters {
  291. my ($proto, $ipvnum, $idnum, $verbose, $which) = @_;
  292. my $server;
  293. my $pidfile;
  294. my $pid;
  295. return if($proto !~ /^(ftp|imap|pop3|smtp)$/);
  296. die "unsupported sockfilter: $which"
  297. if($which && ($which !~ /^(main|data)$/));
  298. $server = servername_id($proto, $ipvnum, $idnum) if($verbose);
  299. if(!$which || ($which eq 'main')) {
  300. $pidfile = mainsockf_pidfilename($proto, $ipvnum, $idnum);
  301. $pid = processexists($pidfile);
  302. if($pid > 0) {
  303. printf("* kill pid for %s-%s => %d\n", $server,
  304. ($proto eq 'ftp')?'ctrl':'filt', $pid) if($verbose);
  305. pidkill($pid);
  306. pidwait($pid, 0);
  307. }
  308. unlink($pidfile) if(-f $pidfile);
  309. }
  310. return if($proto ne 'ftp');
  311. if(!$which || ($which eq 'data')) {
  312. $pidfile = datasockf_pidfilename($proto, $ipvnum, $idnum);
  313. $pid = processexists($pidfile);
  314. if($pid > 0) {
  315. printf("* kill pid for %s-data => %d\n", $server,
  316. $pid) if($verbose);
  317. pidkill($pid);
  318. pidwait($pid, 0);
  319. }
  320. unlink($pidfile) if(-f $pidfile);
  321. }
  322. }
  323. #######################################################################
  324. # killallsockfilters kills sockfilter processes for all servers.
  325. #
  326. sub killallsockfilters {
  327. my $verbose = $_[0];
  328. for my $proto (('ftp', 'imap', 'pop3', 'smtp')) {
  329. for my $ipvnum (('4', '6')) {
  330. for my $idnum (('1', '2')) {
  331. killsockfilters($proto, $ipvnum, $idnum, $verbose);
  332. }
  333. }
  334. }
  335. }
  336. sub set_advisor_read_lock {
  337. my ($filename) = @_;
  338. if(open(FILEH, ">$filename")) {
  339. close(FILEH);
  340. return;
  341. }
  342. printf "Error creating lock file $filename error: $!";
  343. }
  344. sub clear_advisor_read_lock {
  345. my ($filename) = @_;
  346. if(-f $filename) {
  347. unlink($filename);
  348. }
  349. }
  350. 1;