meqqy.pl 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. use Config::IniFiles;
  5. use File::Basename;
  6. use IO::Handle;
  7. use IO::Select;
  8. use IO::Socket::INET;
  9. use IO::Socket::SSL;
  10. # Better not touch these niQQa ;]
  11. my $PING_NOAUTH = -3;
  12. my $PING_DED = -2;
  13. my $PING_EXIT = -1;
  14. my $AUTHLEN = 64;
  15. my $AUTHREGEX = "[A-Za-z0-9]{$AUTHLEN}";
  16. # ohboyherewego.bmp
  17. my $dirname = dirname(__FILE__);
  18. my $cfg = Config::IniFiles->new(-file => "$dirname/muhconf.ini");
  19. my %CONF;
  20. foreach my $ckey(('addy', 'port', 'backlog', 'accept_timeout', 'auth_timeout', 'client_timeout', 'cert', 'key', 'auth', 'debug', 'verbose')) {
  21. $CONF{$ckey} = $cfg->val('main', $ckey);
  22. }
  23. # czech em conf imo
  24. my $gtfo = 0;
  25. foreach my $k(keys(%CONF)) {
  26. my $v = $CONF{$k};
  27. if($k eq 'addy') {
  28. # Let IO::Socket rep0rt address errors so we can support all formats ;]
  29. }
  30. elsif($k eq 'port') {
  31. if($v !~ /^\d+$/ || $v <= 1024 || $v >= 65535) {
  32. printem("Value for '$k' must be an integer larger than 1024 and less than 65535: $v");
  33. $gtfo = 1;
  34. }
  35. }
  36. elsif($k =~ /^(backlog|client_timeout)$/) {
  37. if($v !~ /^\d+$/ || $v == 0) {
  38. printem("Value for '$k' must be an integer larger than 0: $v");
  39. $gtfo = 1;
  40. }
  41. }
  42. elsif($k =~ /^(accept|auth)_timeout$/) {
  43. if($v !~ /^\d+$/ || $v == 0 || $v > 10) {
  44. printem("Value for '$k' must be an integer larger than 0 and equal to or less than 10: $v");
  45. $gtfo = 1;
  46. }
  47. }
  48. elsif($k eq 'cert') {
  49. if(! -e $v || ! -f $v || ! -r $v) {
  50. printem("Certificate file does not exist, is not a regular file or is not readable: $v");
  51. $gtfo = 1;
  52. }
  53. }
  54. elsif($k eq 'key') {
  55. if(! -e $v || ! -f $v || ! -r $v) {
  56. printem("Key file does not exist, is not a regular file or is not readable: $v");
  57. $gtfo = 1;
  58. }
  59. }
  60. elsif($k eq 'auth') {
  61. if($v !~ /^$AUTHREGEX$/) {
  62. printem("Auth key should be exactly $AUTHLEN chars in length: $v (" . length($v) . ' chars)');
  63. $gtfo = 1;
  64. }
  65. }
  66. elsif($k =~ /^(debug|verbose)$/) {
  67. $CONF{$k} = ((defined($v) && $v) ? 1 : 0);
  68. }
  69. else {
  70. printem("Unknown config directive lol: $k");
  71. }
  72. }
  73. exit 1 if($gtfo); # Got an error lol
  74. printem("RUNNING IN DEBUG MODE (NO AUTH REQUIRED)") if($CONF{debug});
  75. my $srv = IO::Socket::SSL->new(
  76. LocalAddr => $CONF{addy},
  77. LocalPort => $CONF{port},
  78. Proto => 'tcp',
  79. Listen => $CONF{backlog},
  80. SSL_cert_file => $CONF{cert},
  81. SSL_key_file => $CONF{key},
  82. ReuseAddr => 1,
  83. Timeout => $CONF{accept_timeout},
  84. ) or die($@);
  85. # Just in case lol
  86. binmode($srv, ':utf8');
  87. $srv->autoflush(1);
  88. # Cuz we gonna do select shit and not multithreadin ;]
  89. my $readtimeout = pack('qq', 1, 0); # Read timeout for client sockets is 1 sec so it matches can_read() and won't cause the entire fucking server to hang
  90. my $selectem = IO::Select->new($srv);
  91. my %ping;
  92. my %clients;
  93. # w e l o o p y a f
  94. while(1) {
  95. my %readfrom = (); # Cuz only increment pings for clients who didn't send shit 0bv ;]
  96. MAIN: while(my @ready = $selectem->can_read(1)) { # Poll every second yo
  97. foreach my $client(@ready) {
  98. if($client == $srv) { # Master socket also counts towards can_read(), which happens when a new client connects
  99. my $new = $srv->accept;
  100. next if(!$new);
  101. my $ckey = $new->peerhost . ':' . $new->peerport; # Client host and port is used as a key for many of them hashes
  102. $selectem->add($new); # Add to select0r handle
  103. IO::Handle::blocking($new, 0); # Gotta set it to non-blocking so it doesn't block other clients xd
  104. printem("($ckey) New connection");
  105. $new->sockopt(SO_RCVTIMEO, $readtimeout);
  106. # Initialise some shit imo
  107. $clients{$ckey} = { sock => \$new, auth => $CONF{debug} };
  108. $ping{$ckey} = 0;
  109. $readfrom{$ckey} = 0;
  110. next;
  111. }
  112. my $read = 0; # Suddenly disconnected clients still return tru for can_read(), so gotta make sure we _actually_ read something
  113. my $ckey = $client->peerhost . ':' . $client->peerport;
  114. while(my $buf = <$client>) {
  115. $buf =~ s/(^[\r\n]+|[\r\n]+$)//g; # Cuz chomp() seems to fuck with nullbytes
  116. if($buf =~ /^\s*$/) {
  117. # Fucking hack for the client to test if the socket is still good
  118. $read = 2 if($read == 0);
  119. last;
  120. }
  121. printem("($ckey) '$buf'") if($CONF{verbose} || $buf !~ /^!ping/i);
  122. $read = 1; # Actually got some data lol
  123. # Check if auth is (still) needed
  124. if(!$clients{$ckey}->{auth}) {
  125. # Unauthed clients can only do !auth 0bv 0bv
  126. if($buf =~ /^!a(?:uth)?(?: ($AUTHREGEX))?/i) {
  127. if(defined($1) && $1 eq $CONF{'auth'}) {
  128. $clients{$ckey}->{auth} = 1;
  129. sockprint($client, "Accepted authentication");
  130. printem("Accepted key", 1);
  131. next;
  132. }
  133. sockprint($client, "Rejected authentication");
  134. printem("Invalid key", 1);
  135. }
  136. else {
  137. sockprint($client, "Authentication required");
  138. }
  139. $ping{$ckey} = $PING_NOAUTH;
  140. last;
  141. }
  142. # Usable commands go hur ;];]
  143. if($buf =~ /^!ping/i) {
  144. next;
  145. }
  146. if($buf =~ /^!(q(uit)?|e(xit)?)/i) {
  147. # $PING_EXIT makes this shit do a clean close() =]]
  148. $ping{$ckey} = $PING_EXIT;
  149. last MAIN;
  150. }
  151. if($buf =~ /^!prev/i) {
  152. # Probs also works for VLC or other media players, just have to verify the AppleScript subcommands being implemented in them ;]
  153. `osascript -e 'tell application "iTunes"
  154. if player position is less than 5 then
  155. previous track
  156. else
  157. set player position to 0
  158. end if
  159. end tell'`;
  160. next;
  161. }
  162. if($buf =~ /^!next/i) {
  163. `osascript -e 'tell application "iTunes"
  164. next track
  165. end tell'`;
  166. next;
  167. }
  168. if($buf =~ /^!p(lay(?:pause)?|ause)?/i) {
  169. `osascript -e 'tell application "iTunes"
  170. playpause
  171. end tell'`;
  172. next;
  173. }
  174. if($buf =~ /^!(?:v(ol(ume)?)?(?:\s+([-+]?\d+))?|cur(?:rent)?vol(?:ume)?)/i) {
  175. # !vol, !vol 10, !vol +10, !vol -10 are all acceptable ;3
  176. my $vol = $3; # The inner part of em optional grupp from above ;]
  177. my $curvol = `osascript -e 'set ovol to output volume of (get volume settings)'`;
  178. chomp($curvol); # THANKS APPLE
  179. if(!defined($vol)) {
  180. sockprint($client, "[volume] Current: $curvol");
  181. next;
  182. }
  183. # There's actually 2 ways to change volume, but one of em has a range 1-10 so fuck that [==[=[=[=[
  184. my $newvol = $vol;
  185. $newvol = $curvol + $vol if($vol =~ /[-+]/);
  186. if($newvol < 0 || $newvol > 100) {
  187. printem("(ckey) [volume] Value out of range (0-100): $newvol");
  188. sockprint($client, "[volume] Value out of range (0-100): $newvol");
  189. next;
  190. }
  191. `osascript -e 'set volume output volume $newvol'`;
  192. next;
  193. }
  194. if($buf =~ /^!(un?)?m(?:ute)?/i) {
  195. if(defined($1)) { # !unmute always tries to unmute
  196. `osascript -e 'set volume without output muted'`;
  197. next;
  198. }
  199. # Otherwise get the current status and flip that shit fam
  200. my $ismuted = `osascript -e 'output muted of (get volume settings)'`;
  201. if($ismuted =~ /^true/i) {
  202. `osascript -e 'set volume without output muted'`;
  203. }
  204. else {
  205. `osascript -e 'set volume with output muted'`;
  206. }
  207. next;
  208. }
  209. if($buf =~ /^!l(ock)?(screen)?/i) {
  210. # Locks da skr33n ;]
  211. `'/System/Library/CoreServices/Menu Extras/User.menu/Contents/Resources/CGSession' -suspend`;
  212. next;
  213. }
  214. if($buf =~ /^!(?:b(right(ness)?)?(?: (up?|d(?:own)?|min|max|\d+))?|cur(?:rent)?bright(?:ness)?)/i) {
  215. # When using an external keyboard the key codes change from 107 and 113 to 145 and 144 (respectively), to lower/raise the brightness level
  216. my $brightness = $3;
  217. if(!defined($brightness)) {
  218. # This shit is massively fucked =]
  219. # * group 1 is for older OS X versions (like Yosemite and bel0 or some shit), as well as _any_ other version without a retina display
  220. # * group 2 is for newer ones w/ retina displays, cuz for those there are extra settings in regards to text size etc
  221. # * It opens System Preferences in hidden windows and quits the application if it wasn't running before
  222. # * Since there might be multiple displays, it'll iterate thru all of them and stops after encountering one with an actual brightness slider
  223. # * Idfk if it works on non-English OSes due to the name "displaysDisplayTab" thingy ;3
  224. my $curbright = `osascript -e '
  225. tell application "System Preferences"
  226. set prefsrunnan to running
  227. set the current pane to pane id "com.apple.preference.displays"
  228. reveal (first anchor of current pane whose name is "displaysDisplayTab")
  229. end tell
  230. tell application "System Events"
  231. tell process "System Preferences"
  232. set curbrightness to -1
  233. copy (name of every window) to winlist
  234. repeat with i from 1 to (count winlist)
  235. tell tab group 1 of window (item i of winlist)
  236. try
  237. tell slider 1 of group 1
  238. set curbrightness to value
  239. end tell
  240. on error
  241. try
  242. tell slider 1 of group 2
  243. set curbrightness to value
  244. end tell
  245. end try
  246. end try
  247. end tell
  248. if curbrightness is not -1 then exit repeat
  249. end repeat
  250. end tell
  251. end tell
  252. if not prefsrunnan then quit application "System Preferences"
  253. curbrightness'`;
  254. $curbright =~ s/(^[\r\n]+|[\r\n]+$)//g; # Cuz chomp() seems to fuck with nullbytes
  255. if($curbright =~ /^-/ || $curbright =~ /^\s*$/) {
  256. sockprint($client, "[brightness] Unable to get current brightness (got: $curbright)");
  257. }
  258. else {
  259. $curbright *= 64;
  260. $curbright =~ s/^(\d+)\..*/$1/; # Make sure we only use integers (always rounded down imo tbh) =]
  261. sockprint($client, "[brightness] Current: $curbright");
  262. }
  263. next;
  264. }
  265. if($brightness =~ /up?/i) {
  266. `osascript -e 'tell application "System Events"
  267. key code 113 using {option down, shift down}
  268. end tell'`;
  269. }
  270. elsif($brightness =~ /d(?:own)?/i) {
  271. `osascript -e 'tell application "System Events"
  272. key code 107 using {option down, shift down}
  273. end tell'`;
  274. }
  275. elsif($brightness =~ /min/i) {
  276. `osascript -e 'tell application "System Events"
  277. repeat 16 times
  278. key code 107
  279. end repeat
  280. key code 113
  281. end tell'`;
  282. }
  283. elsif($brightness =~ /max/i) {
  284. `osascript -e 'tell application "System Events"
  285. repeat 16 times
  286. key code 113
  287. end repeat
  288. end tell'`;
  289. }
  290. else {
  291. if($brightness < 0 || $brightness > 64) {
  292. printem("($ckey) [brightness] Value out of range (0-64): $brightness");
  293. sockprint($client, "[brightness] Value out of range (0-64): $brightness");
  294. next;
  295. }
  296. my ($fullsteps) = ($brightness / 4) =~ /^(\d+)/;
  297. $brightness -= ($fullsteps * 4);
  298. # Fully dim screen then up it till we get to the desired val00 =]]]
  299. `osascript -e 'tell application "System Events"
  300. repeat 16 times
  301. key code 107
  302. end repeat
  303. repeat $fullsteps times
  304. key code 113
  305. end repeat
  306. repeat $brightness times
  307. key code 113 using {option down, shift down}
  308. end repeat
  309. end tell'`;
  310. }
  311. next;
  312. }
  313. if($buf =~ /^!c(affeinate)? ((?:\d+h\s*)?(?:\d+m\s*)?(?:\d+s)?)/i) {
  314. my $timestr = $2;
  315. my $sec = 0;
  316. if($timestr =~ /(\d+)h/i) {
  317. my $h = $1;
  318. $sec += ($h * 60 * 60);
  319. $timestr =~ s/${h}h\s*//;
  320. }
  321. if($timestr =~ /(\d+)m/i) {
  322. my $m = $1;
  323. $sec += ($m * 60);
  324. $timestr =~ s/${m}m\s*//;
  325. }
  326. if($timestr =~ /(\d+)s?/i) {
  327. $sec += $1;
  328. }
  329. if($sec > 0) {
  330. # d = prevent display sleep, i = prevent system idle sleep -- at least one of these also prevents em screensaver ;]
  331. # Truly fork that shit as well (i.e. even when we shut down this one will keep runnan)
  332. `killall caffeinate 2>/dev/null ; caffeinate -di -t $sec </dev/null >/dev/null 2>&1 &`;
  333. next;
  334. }
  335. }
  336. if($buf =~ /^!decaf(feinate)?/i) {
  337. `killall caffeinate 2>/dev/null`;
  338. next;
  339. }
  340. sockprint($client, "Unknown/incomplete command: $buf");
  341. printem("Unknown/incomplete command", 1);
  342. }
  343. # Let's not forget to reset em ping on any command ;];];;]];
  344. if($read > 0) {
  345. $readfrom{$ckey} = $read;
  346. }
  347. else {
  348. $ping{$ckey} = $PING_DED;
  349. last MAIN; # Required so we won't go into an infinite loop using 100% CPU lmao
  350. }
  351. }
  352. }
  353. # Increment pings where necessary
  354. foreach my $ckey(keys(%clients)) {
  355. if(exists($readfrom{$ckey})) {
  356. my $kek = $readfrom{$ckey};
  357. delete($readfrom{$ckey});
  358. if($kek == 1 && $ping{$ckey} >= 0) {
  359. $ping{$ckey} = 0;
  360. next;
  361. }
  362. }
  363. # Shit's < 0 on error, otherwise it must exceed certain thresh0lds
  364. if($ping{$ckey} < 0 || ++$ping{$ckey} >= $CONF{client_timeout} || (!$clients{$ckey}->{auth} && $ping{$ckey} >= $CONF{auth_timeout})) {
  365. my $client = ${$clients{$ckey}->{sock}};
  366. $selectem->remove($client);
  367. if($ping{$ckey} > 0) { # Ping or auth timeout y0
  368. my $werd = 'Ping';
  369. my $werdlc = 'ping';
  370. my $werdto = $CONF{client_timeout};
  371. if(!$clients{$ckey}->{auth}) {
  372. $werd = 'Auth';
  373. $werdlc = 'auth';
  374. $werdto = $CONF{auth_timeout};
  375. }
  376. sockprint($client, "$werd timeout lol");
  377. printem("($ckey) Closed connection due to $werdlc timeout ($ping{$ckey} >= $werdto)");
  378. }
  379. elsif($ping{$ckey} == $PING_EXIT) {
  380. printem("Cleaning up socket", 1);
  381. }
  382. elsif($ping{$ckey} == $PING_DED) {
  383. printem("($ckey) Cleaning up supposedly dead socket");
  384. }
  385. elsif($ping{$ckey} == $PING_NOAUTH) {
  386. printem("Cleaning up unauthorised socket", 1);
  387. }
  388. $client->shutdown(2);
  389. $client->close;
  390. delete($clients{$ckey});
  391. delete($ping{$ckey});
  392. delete($readfrom{$ckey});
  393. }
  394. }
  395. }
  396. sub printem {
  397. my ($msg, $tabs) = @_;
  398. return if(!defined($msg) || $msg =~ /^\s*$/);
  399. my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
  400. printf("[%02d/%02d/%04d %02d:%02d:%02d] ", $mday, $mon + 1, $year + 1900, $hour, $min, $sec);
  401. if(defined($tabs) && $tabs =~ /^\d+$/) {
  402. print " " for(1...$tabs);
  403. }
  404. print "$msg\r\n";
  405. }
  406. sub sockprint {
  407. my ($sock, $msg) = @_;
  408. print $sock "$msg\r\n";
  409. }