2
0

processhelp.pm 12 KB

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