88_HMCCURPCPROC.pm 82 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756
  1. ##############################################################################
  2. #
  3. # 88_HMCCURPCPROC.pm
  4. #
  5. # $Id: 88_HMCCURPCPROC.pm 17672 2018-11-04 12:40:18Z zap $
  6. #
  7. # Version 1.2
  8. #
  9. # Subprocess based RPC Server module for HMCCU.
  10. #
  11. # (c) 2018 by zap (zap01 <at> t-online <dot> de)
  12. #
  13. ##############################################################################
  14. #
  15. # Required perl modules:
  16. #
  17. # RPC::XML::Client
  18. # RPC::XML::Server
  19. #
  20. ##############################################################################
  21. package main;
  22. use strict;
  23. use warnings;
  24. use RPC::XML::Client;
  25. use RPC::XML::Server;
  26. use SetExtensions;
  27. ######################################################################
  28. # Constants
  29. ######################################################################
  30. # HMCCURPC version
  31. my $HMCCURPCPROC_VERSION = '1.2';
  32. # Maximum number of events processed per call of Read()
  33. my $HMCCURPCPROC_MAX_EVENTS = 100;
  34. # Maximum number of errors during socket write before log message is written
  35. my $HMCCURPCPROC_MAX_IOERRORS = 100;
  36. # Maximum number of elements in queue
  37. my $HMCCURPCPROC_MAX_QUEUESIZE = 500;
  38. # Maximum number of events to be send to FHEM within one function call
  39. my $HMCCURPCPROC_MAX_QUEUESEND = 70;
  40. # Time to wait after data processing loop in microseconds
  41. my $HMCCURPCPROC_TIME_WAIT = 100000;
  42. # Timeout for established CCU connection
  43. my $HMCCURPCPROC_TIMEOUT_CONNECTION = 1;
  44. # Timeout for TriggerIO()
  45. my $HMCCURPCPROC_TIMEOUT_WRITE = 0.001;
  46. # Timeout for accepting incoming connections (0 = default)
  47. my $HMCCURPCPROC_TIMEOUT_ACCEPT = 1;
  48. # Timeout for incoming CCU events
  49. my $HMCCURPCPROC_TIMEOUT_EVENT = 600;
  50. # Send statistic information after specified amount of events
  51. my $HMCCURPCPROC_STATISTICS = 500;
  52. # Default RPC Port = BidCos-RF
  53. my $HMCCURPCPROC_RPC_PORT_DEFAULT = 2001;
  54. # Default RPC server base port
  55. my $HMCCURPCPROC_SERVER_PORT = 5400;
  56. # Delay for RPC server start after FHEM is initialized
  57. my $HMCCURPCPROC_INIT_INTERVAL0 = 12;
  58. # Delay for RPC server cleanup after stop
  59. my $HMCCURPCPROC_INIT_INTERVAL2 = 30;
  60. # Delay for RPC server functionality check after start
  61. my $HMCCURPCPROC_INIT_INTERVAL3 = 25;
  62. # BinRPC data types
  63. my $BINRPC_INTEGER = 1;
  64. my $BINRPC_BOOL = 2;
  65. my $BINRPC_STRING = 3;
  66. my $BINRPC_DOUBLE = 4;
  67. my $BINRPC_BASE64 = 17;
  68. my $BINRPC_ARRAY = 256;
  69. my $BINRPC_STRUCT = 257;
  70. # BinRPC message types
  71. my $BINRPC_REQUEST = 0x42696E00;
  72. my $BINRPC_RESPONSE = 0x42696E01;
  73. my $BINRPC_REQUEST_HEADER = 0x42696E40;
  74. my $BINRPC_ERROR = 0x42696EFF;
  75. ######################################################################
  76. # Functions
  77. ######################################################################
  78. # Standard functions
  79. sub HMCCURPCPROC_Initialize ($);
  80. sub HMCCURPCPROC_Define ($$);
  81. sub HMCCURPCPROC_InitDevice ($$);
  82. sub HMCCURPCPROC_Undef ($$);
  83. sub HMCCURPCPROC_Shutdown ($);
  84. sub HMCCURPCPROC_Attr ($@);
  85. sub HMCCURPCPROC_Set ($@);
  86. sub HMCCURPCPROC_Get ($@);
  87. sub HMCCURPCPROC_Read ($);
  88. sub HMCCURPCPROC_SetError ($$$);
  89. sub HMCCURPCPROC_SetState ($$);
  90. sub HMCCURPCPROC_ProcessEvent ($$);
  91. # RPC server control functions
  92. sub HMCCURPCPROC_GetRPCServerID ($$);
  93. sub HMCCURPCPROC_RegisterCallback ($$);
  94. sub HMCCURPCPROC_DeRegisterCallback ($$);
  95. sub HMCCURPCPROC_InitRPCServer ($$$$);
  96. sub HMCCURPCPROC_StartRPCServer ($);
  97. sub HMCCURPCPROC_RPCServerStarted ($);
  98. sub HMCCURPCPROC_RPCServerStopped ($);
  99. sub HMCCURPCPROC_CleanupProcess ($);
  100. sub HMCCURPCPROC_CleanupIO ($);
  101. sub HMCCURPCPROC_TerminateProcess ($);
  102. sub HMCCURPCPROC_CheckProcessState ($$);
  103. sub HMCCURPCPROC_IsRPCServerRunning ($);
  104. sub HMCCURPCPROC_Housekeeping ($);
  105. sub HMCCURPCPROC_StopRPCServer ($);
  106. sub HMCCURPCPROC_SendRequest ($@);
  107. sub HMCCURPCPROC_SetRPCState ($$$$);
  108. sub HMCCURPCPROC_ResetRPCState ($);
  109. sub HMCCURPCPROC_IsRPCStateBlocking ($);
  110. # Helper functions
  111. sub HMCCURPCPROC_GetAttribute ($$$$);
  112. sub HMCCURPCPROC_HexDump ($$);
  113. # RPC server functions
  114. sub HMCCURPCPROC_ProcessRequest ($$);
  115. sub HMCCURPCPROC_HandleConnection ($$$$);
  116. sub HMCCURPCPROC_SendQueue ($$$$);
  117. sub HMCCURPCPROC_SendData ($$);
  118. sub HMCCURPCPROC_Write ($$$$);
  119. sub HMCCURPCPROC_WriteStats ($$);
  120. sub HMCCURPCPROC_NewDevicesCB ($$$);
  121. sub HMCCURPCPROC_DeleteDevicesCB ($$$);
  122. sub HMCCURPCPROC_UpdateDeviceCB ($$$$);
  123. sub HMCCURPCPROC_ReplaceDeviceCB ($$$$);
  124. sub HMCCURPCPROC_ReaddDevicesCB ($$$);
  125. sub HMCCURPCPROC_EventCB ($$$$$);
  126. sub HMCCURPCPROC_ListDevicesCB ($$);
  127. # Binary RPC encoding functions
  128. sub HMCCURPCPROC_EncInteger ($);
  129. sub HMCCURPCPROC_EncBool ($);
  130. sub HMCCURPCPROC_EncString ($);
  131. sub HMCCURPCPROC_EncName ($);
  132. sub HMCCURPCPROC_EncDouble ($);
  133. sub HMCCURPCPROC_EncBase64 ($);
  134. sub HMCCURPCPROC_EncArray ($);
  135. sub HMCCURPCPROC_EncStruct ($);
  136. sub HMCCURPCPROC_EncType ($$);
  137. sub HMCCURPCPROC_EncodeRequest ($$);
  138. sub HMCCURPCPROC_EncodeResponse ($$);
  139. # Binary RPC decoding functions
  140. sub HMCCURPCPROC_DecInteger ($$$);
  141. sub HMCCURPCPROC_DecBool ($$);
  142. sub HMCCURPCPROC_DecString ($$);
  143. sub HMCCURPCPROC_DecDouble ($$);
  144. sub HMCCURPCPROC_DecBase64 ($$);
  145. sub HMCCURPCPROC_DecArray ($$);
  146. sub HMCCURPCPROC_DecStruct ($$);
  147. sub HMCCURPCPROC_DecType ($$);
  148. sub HMCCURPCPROC_DecodeRequest ($);
  149. sub HMCCURPCPROC_DecodeResponse ($);
  150. ######################################################################
  151. # Initialize module
  152. ######################################################################
  153. sub HMCCURPCPROC_Initialize ($)
  154. {
  155. my ($hash) = @_;
  156. $hash->{DefFn} = "HMCCURPCPROC_Define";
  157. $hash->{UndefFn} = "HMCCURPCPROC_Undef";
  158. $hash->{SetFn} = "HMCCURPCPROC_Set";
  159. $hash->{GetFn} = "HMCCURPCPROC_Get";
  160. $hash->{ReadFn} = "HMCCURPCPROC_Read";
  161. $hash->{AttrFn} = "HMCCURPCPROC_Attr";
  162. $hash->{ShutdownFn} = "HMCCURPCPROC_Shutdown";
  163. $hash->{parseParams} = 1;
  164. $hash->{AttrList} = "ccuflags:multiple-strict,expert,reconnect,logEvents,ccuInit,queueEvents,noEvents".
  165. " rpcMaxEvents rpcQueueSend rpcQueueSize rpcMaxIOErrors".
  166. " rpcServerAddr rpcServerPort rpcWriteTimeout rpcAcceptTimeout".
  167. " rpcConnTimeout rpcStatistics rpcEventTimeout ".
  168. $readingFnAttributes;
  169. }
  170. ######################################################################
  171. # Define device
  172. ######################################################################
  173. sub HMCCURPCPROC_Define ($$)
  174. {
  175. my ($hash, $a, $h) = @_;
  176. my $name = $hash->{NAME};
  177. my $hmccu_hash;
  178. my $ioname = '';
  179. my $rpcip = '';
  180. my $iface;
  181. my $usage = "Usage: define $name HMCCURPCPROC { CCUHost | iodev={device} } { RPCPort | RPCInterface }";
  182. $hash->{version} = $HMCCURPCPROC_VERSION;
  183. if (exists ($h->{iodev})) {
  184. $ioname = $h->{iodev};
  185. return $usage if (scalar (@$a) < 3);
  186. return "HMCCU I/O device $ioname not found" if (!exists ($defs{$ioname}));
  187. return "Device $ioname is not a HMCCU device" if ($defs{$ioname}->{TYPE} ne 'HMCCU');
  188. $hmccu_hash = $defs{$ioname};
  189. if (scalar (@$a) < 4) {
  190. $hash->{host} = $hmccu_hash->{host};
  191. $iface = $$a[2];
  192. }
  193. else {
  194. $hash->{host} = $$a[2];
  195. $iface = $$a[3];
  196. }
  197. $rpcip = HMCCU_ResolveName ($hash->{host}, 'N/A');
  198. }
  199. else {
  200. return $usage if (scalar (@$a) < 4);
  201. $hash->{host} = $$a[2];
  202. $iface = $$a[3];
  203. $rpcip = HMCCU_ResolveName ($hash->{host}, 'N/A');
  204. # Find IO device
  205. for my $d (keys %defs) {
  206. my $dh = $defs{$d};
  207. next if (!exists ($dh->{TYPE}) || !exists ($dh->{NAME}));
  208. next if ($dh->{TYPE} ne 'HMCCU');
  209. # The following call will fail during FHEM start if CCU is not ready
  210. my $ifhost = HMCCU_GetRPCServerInfo ($dh, $iface, 'host');
  211. next if (!defined ($ifhost));
  212. if ($dh->{host} eq $hash->{host} || $ifhost eq $hash->{host} || $ifhost eq $rpcip) {
  213. $hmccu_hash = $dh;
  214. last;
  215. }
  216. }
  217. }
  218. # Store some definitions for delayed initialization
  219. $hash->{hmccu}{devspec} = $iface;
  220. $hash->{rpcip} = $rpcip;
  221. if ($init_done) {
  222. # Interactive define command while CCU not ready or no IO device defined
  223. if (!defined ($hmccu_hash)) {
  224. my ($ccuactive, $ccuinactive) = HMCCU_IODeviceStates ();
  225. if ($ccuinactive > 0) {
  226. return "CCU and/or IO device not ready. Please try again later";
  227. }
  228. else {
  229. return "Cannot detect IO device";
  230. }
  231. }
  232. }
  233. else {
  234. # CCU not ready during FHEM start
  235. if (!defined ($hmccu_hash) || $hmccu_hash->{ccustate} ne 'active') {
  236. Log3 $name, 2, "HMCCURPCPROC: [$name] Cannot detect IO device, maybe CCU not ready. Trying later ...";
  237. readingsSingleUpdate ($hash, "state", "Pending", 1);
  238. $hash->{ccudevstate} = 'pending';
  239. return undef;
  240. }
  241. }
  242. # Initialize FHEM device, set IO device
  243. my $rc = HMCCURPCPROC_InitDevice ($hmccu_hash, $hash);
  244. return "Invalid port or interface $iface" if ($rc == 1);
  245. return "Can't assign I/O device $ioname" if ($rc == 2);
  246. return "Invalid local IP address ".$hash->{hmccu}{localaddr} if ($rc == 3);
  247. return "RPC device for CCU/port already exists" if ($rc == 4);
  248. return "Cannot connect to CCU ".$hash->{host}." interface $iface" if ($rc == 5);
  249. return undef;
  250. }
  251. ######################################################################
  252. # Initialization of FHEM device.
  253. # Called during Define() or by HMCCU after CCU ready.
  254. # Return 0 on successful initialization or >0 on error:
  255. # 1 = Invalid port or interface
  256. # 2 = Cannot assign IO device
  257. # 3 = Invalid local IP address
  258. # 4 = RPC device for CCU/port already exists
  259. # 5 = Cannot connect to CCU
  260. ######################################################################
  261. sub HMCCURPCPROC_InitDevice ($$) {
  262. my ($hmccu_hash, $dev_hash) = @_;
  263. my $name = $dev_hash->{NAME};
  264. my $iface = $dev_hash->{hmccu}{devspec};
  265. # Check if interface is valid
  266. my $ifname = HMCCU_GetRPCServerInfo ($hmccu_hash, $iface, 'name');
  267. my $ifport = HMCCU_GetRPCServerInfo ($hmccu_hash, $iface, 'port');
  268. return 1 if (!defined ($ifname) || !defined ($ifport));
  269. # Check if RPC device with same interface already exists
  270. for my $d (keys %defs) {
  271. my $dh = $defs{$d};
  272. next if (!exists ($dh->{TYPE}) || !exists ($dh->{NAME}));
  273. if ($dh->{TYPE} eq 'HMCCURPCPROC' && $dh->{NAME} ne $name && IsDisabled ($dh->{NAME}) != 1) {
  274. return 4 if ($dev_hash->{host} eq $dh->{host} && exists ($dh->{rpcport}) &&
  275. $dh->{rpcport} == $ifport);
  276. }
  277. }
  278. # Detect local IP address and check if CCU is reachable
  279. my $localaddr = HMCCU_TCPConnect ($dev_hash->{host}, $ifport);
  280. return 5 if ($localaddr eq '');
  281. $dev_hash->{hmccu}{localaddr} = $localaddr;
  282. $dev_hash->{hmccu}{defaultaddr} = $dev_hash->{hmccu}{localaddr};
  283. # Get unique ID for RPC server: last 2 segments of local IP address
  284. # Do not append random digits because of https://forum.fhem.de/index.php/topic,83544.msg797146.html#msg797146
  285. my @ipseg = split (/\./, $dev_hash->{hmccu}{localaddr});
  286. return 3 if (scalar (@ipseg) != 4);
  287. $dev_hash->{rpcid} = sprintf ("%03d%03d", $ipseg[2], $ipseg[3]);
  288. # Set I/O device and store reference for RPC device in I/O device
  289. my $ioname = $hmccu_hash->{NAME};
  290. return 2 if (!HMCCU_AssignIODevice ($dev_hash, $ioname, $ifname));
  291. # Store internals
  292. $dev_hash->{rpcport} = $ifport;
  293. $dev_hash->{rpcinterface} = $ifname;
  294. $dev_hash->{ccuip} = $hmccu_hash->{ccuip};
  295. $dev_hash->{ccutype} = $hmccu_hash->{ccutype};
  296. $dev_hash->{CCUNum} = $hmccu_hash->{CCUNum};
  297. $dev_hash->{ccustate} = $hmccu_hash->{ccustate};
  298. Log3 $name, 1, "HMCCURPCPROC: [$name] Initialized version $HMCCURPCPROC_VERSION for interface $ifname with I/O device $ioname";
  299. # Set some attributes
  300. if ($init_done) {
  301. $attr{$name}{stateFormat} = "rpcstate/state";
  302. $attr{$name}{verbose} = 2;
  303. }
  304. HMCCURPCPROC_ResetRPCState ($dev_hash);
  305. HMCCURPCPROC_SetState ($dev_hash, 'Initialized');
  306. return 0;
  307. }
  308. ######################################################################
  309. # Delete device
  310. ######################################################################
  311. sub HMCCURPCPROC_Undef ($$)
  312. {
  313. my ($hash, $arg) = @_;
  314. my $name = $hash->{NAME};
  315. my $hmccu_hash = $hash->{IODev};
  316. my $ifname = $hash->{rpcinterface};
  317. # Shutdown RPC server
  318. HMCCURPCPROC_Shutdown ($hash);
  319. # Delete RPC device name in I/O device
  320. if (exists ($hmccu_hash->{hmccu}{interfaces}{$ifname}{device}) &&
  321. $hmccu_hash->{hmccu}{interfaces}{$ifname}{device} eq $name) {
  322. delete $hmccu_hash->{hmccu}{interfaces}{$ifname}{device};
  323. }
  324. return undef;
  325. }
  326. ######################################################################
  327. # Shutdown FHEM
  328. ######################################################################
  329. sub HMCCURPCPROC_Shutdown ($)
  330. {
  331. my ($hash) = @_;
  332. # Shutdown RPC server
  333. HMCCURPCPROC_StopRPCServer ($hash);
  334. RemoveInternalTimer ($hash);
  335. return undef;
  336. }
  337. ######################################################################
  338. # Set attribute
  339. ######################################################################
  340. sub HMCCURPCPROC_Attr ($@)
  341. {
  342. my ($cmd, $name, $attrname, $attrval) = @_;
  343. my $hash = $defs{$name};
  344. if ($cmd eq 'set') {
  345. if (($attrname eq 'rpcAcceptTimeout' || $attrname eq 'rpcMaxEvents') && $attrval == 0) {
  346. return "HMCCURPCPROC: [$name] Value for attribute $attrname must be greater than 0";
  347. }
  348. elsif ($attrname eq 'rpcServerAddr') {
  349. $hash->{hmccu}{localaddr} = $attrval;
  350. }
  351. }
  352. elsif ($cmd eq 'del') {
  353. if ($attrname eq 'rpcServerAddr') {
  354. $hash->{hmccu}{localaddr} = $hash->{hmccu}{defaultaddr};
  355. }
  356. }
  357. return undef;
  358. }
  359. ######################################################################
  360. # Set commands
  361. ######################################################################
  362. sub HMCCURPCPROC_Set ($@)
  363. {
  364. my ($hash, $a, $h) = @_;
  365. my $hmccu_hash = $hash->{IODev};
  366. my $name = shift @$a;
  367. my $opt = shift @$a;
  368. my $ccuflags = AttrVal ($name, 'ccuflags', 'null');
  369. my $options = $ccuflags =~ /expert/ ? "cleanup:noArg deregister:noArg register:noArg rpcrequest rpcserver:on,off" : "";
  370. my $busyoptions = $ccuflags =~ /expert/ ? "rpcserver:off" : "";
  371. return "HMCCURPCPROC: CCU busy, choose one of $busyoptions"
  372. if ($opt ne 'rpcserver' && HMCCURPCPROC_IsRPCStateBlocking ($hash));
  373. if ($opt eq 'cleanup') {
  374. HMCCURPCPROC_Housekeeping ($hash);
  375. return undef;
  376. }
  377. elsif ($opt eq 'register') {
  378. if ($hash->{RPCState} eq 'running') {
  379. my ($rc, $rcmsg) = HMCCURPCPROC_RegisterCallback ($hash, 2);
  380. if ($rc) {
  381. $hash->{ccustate} = 'active';
  382. return HMCCURPCPROC_SetState ($hash, "OK");
  383. }
  384. else {
  385. return HMCCURPCPROC_SetError ($hash, $rcmsg, 2);
  386. }
  387. }
  388. else {
  389. return HMCCURPCPROC_SetError ($hash, "RPC server not running", 2);
  390. }
  391. }
  392. elsif ($opt eq 'deregister') {
  393. my ($rc, $err) = HMCCURPCPROC_DeRegisterCallback ($hash, 1);
  394. return HMCCURPCPROC_SetError ($hash, $err, 2) if (!$rc);
  395. return HMCCURPCPROC_SetState ($hash, "OK");
  396. }
  397. elsif ($opt eq 'rpcrequest') {
  398. my $request = shift @$a;
  399. return HMCCURPCPROC_SetError ($hash, "Usage: set $name rpcrequest {request} [{parameter} ...]", 2)
  400. if (!defined ($request));
  401. my $response = HMCCURPCPROC_SendRequest ($hash, $request, @$a);
  402. return HMCCURPCPROC_SetError ($hash, "RPC request failed", 2) if (!defined ($response));
  403. return HMCCU_RefToString ($response);
  404. }
  405. elsif ($opt eq 'rpcserver') {
  406. my $action = shift @$a;
  407. return HMCCURPCPROC_SetError ($hash, "Usage: set $name rpcserver {on|off}", 2)
  408. if (!defined ($action) || $action !~ /^(on|off)$/);
  409. if ($action eq 'on') {
  410. return HMCCURPCPROC_SetError ($hash, "RPC server already running", 2)
  411. if ($hash->{RPCState} ne 'inactive' && $hash->{RPCState} ne 'error');
  412. $hmccu_hash->{hmccu}{interfaces}{$hash->{rpcinterface}}{manager} = 'HMCCURPCPROC';
  413. my ($rc, $info) = HMCCURPCPROC_StartRPCServer ($hash);
  414. if (!$rc) {
  415. HMCCURPCPROC_SetRPCState ($hash, 'error', undef, undef);
  416. return HMCCURPCPROC_SetError ($hash, $info, 1);
  417. }
  418. }
  419. elsif ($action eq 'off') {
  420. $hmccu_hash->{hmccu}{interfaces}{$hash->{rpcinterface}}{manager} = 'HMCCURPCPROC';
  421. HMCCURPCPROC_StopRPCServer ($hash);
  422. }
  423. return undef;
  424. }
  425. else {
  426. return "HMCCURPCPROC: Unknown argument $opt, choose one of ".$options;
  427. }
  428. }
  429. ######################################################################
  430. # Get commands
  431. ######################################################################
  432. sub HMCCURPCPROC_Get ($@)
  433. {
  434. my ($hash, $a, $h) = @_;
  435. my $name = shift @$a;
  436. my $opt = shift @$a;
  437. my $ccuflags = AttrVal ($name, 'ccuflags', 'null');
  438. my $options = "rpcevents:noArg rpcstate:noArg";
  439. return "HMCCURPCPROC: CCU busy, choose one of rpcstate:noArg"
  440. if ($opt ne 'rpcstate' && HMCCURPCPROC_IsRPCStateBlocking ($hash));
  441. my $result = 'Command not implemented';
  442. my $rc;
  443. if ($opt eq 'rpcevents') {
  444. my @eventtypes = ("EV", "ND", "DD", "RD", "RA", "UD", "IN", "EX", "SL", "TO");
  445. my $clkey = 'CB'.$hash->{rpcport}.$hash->{rpcid};
  446. $result = "Event statistics for server $clkey\n";
  447. $result .= "Average event delay = ".$hash->{hmccu}{rpc}{avgdelay}."\n"
  448. if (defined ($hash->{hmccu}{rpc}{avgdelay}));
  449. $result .= "========================================\n";
  450. $result .= "ET Sent by RPC server Received by FHEM\n";
  451. $result .= "----------------------------------------\n";
  452. foreach my $et (@eventtypes) {
  453. my $snd = exists ($hash->{hmccu}{rpc}{snd}{$et}) ?
  454. sprintf ("%7d", $hash->{hmccu}{rpc}{snd}{$et}) : " n/a";
  455. my $rec = exists ($hash->{hmccu}{rpc}{rec}{$et}) ?
  456. sprintf ("%7d", $hash->{hmccu}{rpc}{rec}{$et}) : " n/a";
  457. $result .= "$et $snd $rec\n\n";
  458. }
  459. return $result eq '' ? "No event statistics found" : $result;
  460. }
  461. elsif ($opt eq 'rpcstate') {
  462. my $clkey = 'CB'.$hash->{rpcport}.$hash->{rpcid};
  463. $result = "PID RPC-Process State \n";
  464. $result .= "--------------------------\n";
  465. my $sid = defined ($hash->{hmccu}{rpc}{pid}) ? sprintf ("%5d", $hash->{hmccu}{rpc}{pid}) : "N/A ";
  466. my $sname = sprintf ("%-10s", $clkey);
  467. $result .= $sid." ".$sname." ".$hash->{hmccu}{rpc}{state}."\n";
  468. return $result;
  469. }
  470. else {
  471. return "HMCCURPCPROC: Unknown argument $opt, choose one of ".$options;
  472. }
  473. }
  474. ######################################################################
  475. # Read data from processes
  476. ######################################################################
  477. sub HMCCURPCPROC_Read ($)
  478. {
  479. my ($hash) = @_;
  480. my $name = $hash->{NAME};
  481. my $hmccu_hash = $hash->{IODev};
  482. my $eventcount = 0; # Total number of events
  483. my $devcount = 0; # Number of DD, ND or RD events
  484. my $evcount = 0; # Number of EV events
  485. my %events = ();
  486. my %devices = ();
  487. Log3 $name, 4, "HMCCURPCPROC: [$name] Read called";
  488. # Check if child socket exists
  489. if (!defined ($hash->{hmccu}{sockchild})) {
  490. Log3 $name, 2, "HMCCURPCPROC: [$name] Child socket does not exist";
  491. return;
  492. }
  493. # Get attributes
  494. my $rpcmaxevents = AttrVal ($name, 'rpcMaxEvents', $HMCCURPCPROC_MAX_EVENTS);
  495. my $ccuflags = AttrVal ($name, 'ccuflags', 'null');
  496. my $hmccuflags = AttrVal ($hmccu_hash->{NAME}, 'ccuflags', 'null');
  497. my $socktimeout = AttrVal ($name, 'rpcWriteTimeout', $HMCCURPCPROC_TIMEOUT_WRITE);
  498. # Read events from queue
  499. while (1) {
  500. my ($item, $err) = HMCCURPCPROC_ReceiveData ($hash->{hmccu}{sockchild}, $socktimeout);
  501. if (!defined ($item)) {
  502. Log3 $name, 4, "HMCCURPCPROC: [$name] Read stopped after $eventcount events $err";
  503. last;
  504. }
  505. Log3 $name, 4, "HMCCURPCPROC: [$name] read $item from queue" if ($ccuflags =~ /logEvents/);
  506. my ($et, $clkey, @par) = HMCCURPCPROC_ProcessEvent ($hash, $item);
  507. next if (!defined ($et));
  508. if ($et eq 'EV') {
  509. $events{$par[0]}{$par[1]}{$par[2]} = $par[3];
  510. $evcount++;
  511. $hash->{ccustate} = 'active' if ($hash->{ccustate} ne 'active');
  512. }
  513. elsif ($et eq 'EX') {
  514. # I/O already cleaned up. Leave Read()
  515. last;
  516. }
  517. elsif ($et eq 'ND') {
  518. $devices{$par[0]}{flag} = 'N';
  519. $devices{$par[0]}{version} = $par[3];
  520. if ($par[1] eq 'D') {
  521. $devices{$par[0]}{addtype} = 'dev';
  522. $devices{$par[0]}{type} = $par[2];
  523. $devices{$par[0]}{firmware} = $par[4];
  524. $devices{$par[0]}{rxmode} = $par[5];
  525. }
  526. else {
  527. $devices{$par[0]}{addtype} = 'chn';
  528. $devices{$par[0]}{usetype} = $par[2];
  529. }
  530. $devcount++;
  531. }
  532. elsif ($et eq 'DD') {
  533. $devices{$par[0]}{flag} = 'D';
  534. $devcount++;
  535. }
  536. elsif ($et eq 'RD') {
  537. $devices{$par[0]}{flag} = 'R';
  538. $devices{$par[0]}{newaddr} = $par[1];
  539. $devcount++;
  540. }
  541. $eventcount++;
  542. if ($eventcount > $rpcmaxevents) {
  543. Log3 $name, 4, "HMCCURPCPROC: [$name] Read stopped after $rpcmaxevents events";
  544. last;
  545. }
  546. }
  547. # Update device table and client device readings
  548. HMCCU_UpdateDeviceTable ($hmccu_hash, \%devices) if ($devcount > 0);
  549. HMCCU_UpdateMultipleDevices ($hmccu_hash, \%events)
  550. if ($evcount > 0 && $ccuflags !~ /noEvents/ && $hmccuflags !~ /noEvents/);
  551. Log3 $name, 4, "HMCCURPCPROC: [$name] Read finished";
  552. }
  553. ######################################################################
  554. # Set error state and write log file message
  555. # Parameter level is optional. Default value for level is 1.
  556. ######################################################################
  557. sub HMCCURPCPROC_SetError ($$$)
  558. {
  559. my ($hash, $text, $level) = @_;
  560. my $name = $hash->{NAME};
  561. my $type = $hash->{TYPE};
  562. my $msg;
  563. $msg = defined ($text) ? $text : "unknown error";
  564. $msg = $type.": [".$name."] ". $msg;
  565. HMCCURPCPROC_SetState ($hash, "error");
  566. Log3 $name, (defined($level) ? $level : 1), $msg;
  567. return $msg;
  568. }
  569. ######################################################################
  570. # Set state of device
  571. ######################################################################
  572. sub HMCCURPCPROC_SetState ($$)
  573. {
  574. my ($hash, $state) = @_;
  575. my $name = $hash->{NAME};
  576. if (defined ($state)) {
  577. readingsSingleUpdate ($hash, "state", $state, 1);
  578. Log3 $name, 4, "HMCCURPCPROC: [$name] Set state to $state";
  579. }
  580. return undef;
  581. }
  582. ######################################################################
  583. # Set state of RPC server
  584. # Parameters msg and level are optional. Default for level is 1.
  585. ######################################################################
  586. sub HMCCURPCPROC_SetRPCState ($$$$)
  587. {
  588. my ($hash, $state, $msg, $level) = @_;
  589. my $name = $hash->{NAME};
  590. my $hmccu_hash = $hash->{IODev};
  591. return undef if (exists ($hash->{RPCState}) && $hash->{RPCState} eq $state);
  592. $hash->{hmccu}{rpc}{state} = $state;
  593. $hash->{RPCState} = $state;
  594. readingsSingleUpdate ($hash, "rpcstate", $state, 1);
  595. HMCCURPCPROC_SetState ($hash, 'busy') if ($state ne 'running' && $state ne 'inactive' &&
  596. $state ne 'error' && ReadingsVal ($name, 'state', '') ne 'busy');
  597. Log3 $name, (defined($level) ? $level : 1), "HMCCURPCPROC: [$name] $msg" if (defined ($msg));
  598. Log3 $name, 4, "HMCCURPCPROC: [$name] Set rpcstate to $state";
  599. # Set state of interface in I/O device
  600. HMCCU_SetRPCState ($hmccu_hash, $state, $hash->{rpcinterface});
  601. return undef;
  602. }
  603. ######################################################################
  604. # Reset RPC State
  605. ######################################################################
  606. sub HMCCURPCPROC_ResetRPCState ($)
  607. {
  608. my ($hash) = @_;
  609. my $name = $hash->{NAME};
  610. Log3 $name, 4, "HMCCURPCPROC: [$name] Reset RPC state";
  611. $hash->{RPCPID} = "0";
  612. $hash->{hmccu}{rpc}{pid} = undef;
  613. $hash->{hmccu}{rpc}{clkey} = undef;
  614. $hash->{hmccu}{evtime} = 0;
  615. $hash->{hmccu}{rpcstarttime} = 0;
  616. return HMCCURPCPROC_SetRPCState ($hash, 'inactive', undef, undef);
  617. }
  618. ######################################################################
  619. # Check if CCU is busy due to RPC start or stop
  620. ######################################################################
  621. sub HMCCURPCPROC_IsRPCStateBlocking ($)
  622. {
  623. my ($hash) = @_;
  624. return ($hash->{RPCState} eq "running" || $hash->{RPCState} eq "inactive") ? 0 : 1;
  625. }
  626. ######################################################################
  627. # Process RPC server event
  628. ######################################################################
  629. sub HMCCURPCPROC_ProcessEvent ($$)
  630. {
  631. my ($hash, $event) = @_;
  632. my $name = $hash->{NAME};
  633. my $rpcname = 'CB'.$hash->{rpcport}.$hash->{rpcid};
  634. my $rh = \%{$hash->{hmccu}{rpc}}; # Just for code simplification
  635. my $hmccu_hash = $hash->{IODev};
  636. # Number of arguments in RPC events (without event type and clkey)
  637. my %rpceventargs = (
  638. "EV", 4,
  639. "ND", 6,
  640. "DD", 1,
  641. "RD", 2,
  642. "RA", 1,
  643. "UD", 2,
  644. "IN", 2,
  645. "EX", 2,
  646. "SL", 1,
  647. "TO", 1,
  648. "ST", 11
  649. );
  650. my $ccuflags = AttrVal ($name, 'ccuflags', 'null');
  651. my $evttimeout = HMCCURPCPROC_GetAttribute ($hash, 'rpcEventTimeout', 'rpcevtimeout',
  652. $HMCCURPCPROC_TIMEOUT_EVENT);
  653. # Parse event
  654. return undef if (!defined ($event) || $event eq '');
  655. my @t = split (/\|/, $event);
  656. my $et = shift @t;
  657. my $clkey = shift @t;
  658. my $tc = scalar (@t);
  659. # Log event
  660. Log3 $name, 2, "HMCCURPCPROC: [$name] CCUEvent = $event" if ($ccuflags =~ /logEvents/);
  661. # Check event data
  662. if (!defined ($clkey)) {
  663. Log3 $name, 2, "HMCCURPCPROC: [$name] Syntax error in RPC event data";
  664. return undef;
  665. }
  666. # Check for valid server
  667. if ($clkey ne $rpcname) {
  668. Log3 $name, 2, "HMCCURPCPROC: [$name] Received $et event for unknown RPC server $clkey";
  669. return undef;
  670. }
  671. # Check event type
  672. if (!exists ($rpceventargs{$et})) {
  673. $et =~ s/([\x00-\xFF])/sprintf("0x%X ",ord($1))/eg;
  674. Log3 $name, 2, "HMCCURPCPROC: [$name] Received unknown event from CCU: ".$et;
  675. return undef;
  676. }
  677. # Check event parameters
  678. if ($tc != $rpceventargs{$et}) {
  679. Log3 $name, 2, "HMCCURPCPROC: [$name] Wrong number of parameters in event $event. Expected ".
  680. $rpceventargs{$et};
  681. return undef;
  682. }
  683. # Update statistic counters
  684. $rh->{rec}{$et}++;
  685. $rh->{evtime} = time ();
  686. if ($et eq 'EV') {
  687. #
  688. # Update of datapoint
  689. # Input: EV|clkey|Time|Address|Datapoint|Value
  690. # Output: EV, clkey, DevAdd, ChnNo, Datapoint, Value
  691. #
  692. my $delay = $rh->{evtime}-$t[0];
  693. $rh->{sumdelay} += $delay;
  694. $rh->{avgdelay} = $rh->{sumdelay}/$rh->{rec}{$et};
  695. $hash->{ccustate} = 'active' if ($hash->{ccustate} ne 'active');
  696. Log3 $name, 3, "HMCCURPCPROC: [$name] Received CENTRAL event. ".$t[2]."=".$t[3] if ($t[1] eq 'CENTRAL');
  697. my ($add, $chn) = split (/:/, $t[1]);
  698. return defined ($chn) ? ($et, $clkey, $add, $chn, $t[2], $t[3]) : undef;
  699. }
  700. elsif ($et eq 'SL') {
  701. #
  702. # RPC server enters server loop
  703. # Input: SL|clkey|Pid
  704. # Output: SL, clkey, countWorking
  705. #
  706. if ($t[0] == $rh->{pid}) {
  707. HMCCURPCPROC_SetRPCState ($hash, 'working', "RPC server $clkey enters server loop", 2);
  708. my ($rc, $rcmsg) = HMCCURPCPROC_RegisterCallback ($hash, 0);
  709. if (!$rc) {
  710. HMCCURPCPROC_SetRPCState ($hash, 'error', $rcmsg, 1);
  711. return ($et, $clkey, 1, 0, 0, 0);
  712. }
  713. else {
  714. HMCCURPCPROC_SetRPCState ($hash, $rcmsg, "RPC server $clkey $rcmsg", 1);
  715. }
  716. my $srun = HMCCURPCPROC_RPCServerStarted ($hash);
  717. return ($et, $clkey, ($srun == 0 ? 1 : 0), $srun);
  718. }
  719. else {
  720. Log3 $name, 0, "HMCCURPCPROC: [$name] Received SL event. Wrong PID=".$t[0]." for RPC server $clkey";
  721. return undef;
  722. }
  723. }
  724. elsif ($et eq 'IN') {
  725. #
  726. # RPC server initialized
  727. # Input: IN|clkey|INIT|State
  728. # Output: IN, clkey, Running, ClientsUpdated, UpdateErrors
  729. #
  730. return ($et, $clkey, 0, 0, 0) if ($rh->{state} eq 'running');
  731. HMCCURPCPROC_SetRPCState ($hash, 'running', "RPC server $clkey running.", 1);
  732. my $run = HMCCURPCPROC_RPCServerStarted ($hash);
  733. return ($et, $clkey, $run);
  734. }
  735. elsif ($et eq 'EX') {
  736. #
  737. # Process stopped
  738. # Input: EX|clkey|SHUTDOWN|Pid
  739. # Output: EX, clkey, Pid, Stopped, All
  740. #
  741. HMCCURPCPROC_SetRPCState ($hash, 'inactive', "RPC server process $clkey terminated.", 1);
  742. HMCCURPCPROC_RPCServerStopped ($hash);
  743. return ($et, $clkey, $t[1], 1, 1);
  744. }
  745. elsif ($et eq 'ND') {
  746. #
  747. # CCU device added
  748. # Input: ND|clkey|C/D|Address|Type|Version|Firmware|RxMode
  749. # Output: ND, clkey, DevAdd, C/D, Type, Version, Firmware, RxMode
  750. #
  751. return ($et, $clkey, $t[1], $t[0], $t[2], $t[3], $t[4], $t[5]);
  752. }
  753. elsif ($et eq 'DD' || $et eq 'RA') {
  754. #
  755. # CCU device deleted or readded
  756. # Input: {DD,RA}|clkey|Address
  757. # Output: {DD,RA}, clkey, DevAdd
  758. #
  759. return ($et, $clkey, $t[0]);
  760. }
  761. elsif ($et eq 'UD') {
  762. #
  763. # CCU device updated
  764. # Input: UD|clkey|Address|Hint
  765. # Output: UD, clkey, DevAdd, Hint
  766. #
  767. return ($et, $clkey, $t[0], $t[1]);
  768. }
  769. elsif ($et eq 'RD') {
  770. #
  771. # CCU device replaced
  772. # Input: RD|clkey|Address1|Address2
  773. # Output: RD, clkey, Address1, Address2
  774. #
  775. return ($et, $clkey, $t[0], $t[1]);
  776. }
  777. elsif ($et eq 'ST') {
  778. #
  779. # Statistic data. Store snapshots of sent events.
  780. # Input: ST|clkey|nTotal|nEV|nND|nDD|nRD|nRA|nUD|nIN|nEX|nSL
  781. # Output: ST, clkey, ...
  782. #
  783. my @res = ($et, $clkey);
  784. push (@res, @t);
  785. my $total = shift @t;
  786. my @eventtypes = ("EV", "ND", "DD", "RD", "RA", "UD", "IN", "EX", "SL", "TO");
  787. for (my $i=0; $i<scalar(@eventtypes); $i++) {
  788. $hash->{hmccu}{rpc}{snd}{$eventtypes[$i]} += $t[$i];
  789. }
  790. return @res;
  791. }
  792. elsif ($et eq 'TO') {
  793. #
  794. # Event timeout
  795. # Input: TO|clkey|Time
  796. # Output: TO, clkey, Port, Time
  797. #
  798. if ($evttimeout > 0 && $evttimeout >= $t[0]) {
  799. Log3 $name, 2, "HMCCURPCPROC: [$name] Received no events from interface $clkey for ".$t[0]." seconds";
  800. $hash->{ccustate} = 'timeout';
  801. if ($hash->{RPCState} eq 'running' && $ccuflags =~ /reconnect/) {
  802. Log3 $name, 2, "HMCCURPCPROC: [$name] Reconnecting to CCU interface ".$hash->{rpcinterface};
  803. my ($rc, $rcmsg) = HMCCURPCPROC_RegisterCallback ($hash, 2);
  804. if ($rc) {
  805. $hash->{ccustate} = 'active';
  806. }
  807. else {
  808. Log3 $name, 1, "HMCCURPCPROC: [$name] $rcmsg";
  809. }
  810. }
  811. DoTrigger ($name, "No events from interface $clkey for ".$t[0]." seconds");
  812. }
  813. return ($et, $clkey, $hash->{rpcport}, $t[0]);
  814. }
  815. return undef;
  816. }
  817. ######################################################################
  818. # Get attribute with fallback to I/O device attribute
  819. ######################################################################
  820. sub HMCCURPCPROC_GetAttribute ($$$$)
  821. {
  822. my ($hash, $attr, $ioattr, $default) = @_;
  823. my $name = $hash->{NAME};
  824. my $hmccu_hash = $hash->{IODev};
  825. my $value = 'null';
  826. if (defined ($attr)) {
  827. $value = AttrVal ($name, $attr, 'null');
  828. return $value if ($value ne 'null');
  829. }
  830. if (defined ($ioattr)) {
  831. $value = AttrVal ($hmccu_hash->{NAME}, $ioattr, 'null');
  832. return $value if ($value ne 'null');
  833. }
  834. return $default;
  835. }
  836. ######################################################################
  837. # Register callback for specified CCU interface port.
  838. # Parameter force:
  839. # 1: callback will be registered even if state is "running". State
  840. # will not be modified.
  841. # 2: CCU connectivity is checked before registering RPC server.
  842. # Return (1, new state) on success. New state is 'running' if flag
  843. # ccuInit is not set. Otherwise 'registered'.
  844. # Return (0, errormessage) on error.
  845. ######################################################################
  846. sub HMCCURPCPROC_RegisterCallback ($$)
  847. {
  848. my ($hash, $force) = @_;
  849. my $name = $hash->{NAME};
  850. my $hmccu_hash = $hash->{IODev};
  851. my $ccuflags = AttrVal ($name, 'ccuflags', 'null');
  852. my $port = $hash->{rpcport};
  853. my $serveraddr = $hash->{host};
  854. my $localaddr = $hash->{hmccu}{localaddr};
  855. my $clkey = 'CB'.$port.$hash->{rpcid};
  856. return (0, "RPC server $clkey not in state working")
  857. if ($hash->{hmccu}{rpc}{state} ne 'working' && $force == 0);
  858. if ($force == 2) {
  859. return (0, "CCU port $port not reachable") if (!HMCCU_TCPConnect ($hash->{host}, $port));
  860. }
  861. my $cburl = HMCCU_GetRPCCallbackURL ($hmccu_hash, $localaddr, $hash->{hmccu}{rpc}{cbport}, $clkey, $port);
  862. my $clurl = HMCCU_GetRPCServerInfo ($hmccu_hash, $port, 'url');
  863. my $rpctype = HMCCU_GetRPCServerInfo ($hmccu_hash, $port, 'type');
  864. return (0, "Can't get RPC parameters for ID $clkey") if (!defined ($cburl) || !defined ($clurl) || !defined ($rpctype));
  865. $hash->{hmccu}{rpc}{port} = $port;
  866. $hash->{hmccu}{rpc}{clurl} = $clurl;
  867. $hash->{hmccu}{rpc}{cburl} = $cburl;
  868. Log3 $name, 2, "HMCCURPCPROC: [$name] Registering callback $cburl of type $rpctype with ID $clkey at $clurl";
  869. my $rc;
  870. if ($rpctype eq 'A') {
  871. $rc = HMCCURPCPROC_SendRequest ($hash, "init", $cburl, $clkey);
  872. }
  873. else {
  874. $rc = HMCCURPCPROC_SendRequest ($hash, "init", $BINRPC_STRING, $cburl, $BINRPC_STRING, $clkey);
  875. }
  876. if (defined ($rc)) {
  877. return (1, $ccuflags !~ /ccuInit/ ? 'running' : 'registered');
  878. }
  879. else {
  880. return (0, "Failed to register callback for ID $clkey");
  881. }
  882. }
  883. ######################################################################
  884. # Deregister RPC callbacks at CCU
  885. ######################################################################
  886. sub HMCCURPCPROC_DeRegisterCallback ($$)
  887. {
  888. my ($hash, $force) = @_;
  889. my $name = $hash->{NAME};
  890. my $hmccu_hash = $hash->{IODev};
  891. my $port = $hash->{rpcport};
  892. my $clkey = 'CB'.$port.$hash->{rpcid};
  893. my $localaddr = $hash->{hmccu}{localaddr};
  894. my $cburl = '';
  895. my $clurl = '';
  896. my $rpchash = \%{$hash->{hmccu}{rpc}};
  897. return (0, "RPC server $clkey not in state registered or running")
  898. if ($rpchash->{state} ne 'registered' && $rpchash->{state} ne 'running' && $force == 0);
  899. $cburl = $rpchash->{cburl} if (exists ($rpchash->{cburl}));
  900. $clurl = $rpchash->{clurl} if (exists ($rpchash->{clurl}));
  901. $cburl = HMCCU_GetRPCCallbackURL ($hmccu_hash, $localaddr, $rpchash->{cbport}, $clkey, $port) if ($cburl eq '');
  902. $clurl = HMCCU_GetRPCServerInfo ($hmccu_hash, $port, 'url') if ($clurl eq '');
  903. return (0, "Can't get RPC parameters for ID $clkey") if ($cburl eq '' || $clurl eq '');
  904. Log3 $name, 1, "HMCCURPCPROC: [$name] Deregistering RPC server $cburl with ID $clkey at $clurl";
  905. # Deregister up to 2 times
  906. for (my $i=0; $i<2; $i++) {
  907. my $rc;
  908. if (HMCCU_IsRPCType ($hmccu_hash, $port, 'A')) {
  909. $rc = HMCCURPCPROC_SendRequest ($hash, "init", $cburl);
  910. }
  911. else {
  912. $rc = HMCCURPCPROC_SendRequest ($hash, "init", $BINRPC_STRING, $cburl);
  913. }
  914. if (defined ($rc)) {
  915. HMCCURPCPROC_SetRPCState ($hash, $force == 0 ? 'deregistered' : $rpchash->{state},
  916. "Callback for RPC server $clkey deregistered", 1);
  917. $rpchash->{cburl} = '';
  918. $rpchash->{clurl} = '';
  919. $rpchash->{cbport} = 0;
  920. return (1, 'working');
  921. }
  922. }
  923. return (0, "Failed to deregister RPC server $clkey");
  924. }
  925. ######################################################################
  926. # Initialize RPC server for specified CCU port
  927. # Return server object or undef on error
  928. ######################################################################
  929. sub HMCCURPCPROC_InitRPCServer ($$$$)
  930. {
  931. my ($name, $clkey, $callbackport, $prot) = @_;
  932. my $server;
  933. # Create binary RPC server
  934. if ($prot eq 'B') {
  935. $server->{__daemon} = IO::Socket::INET->new (LocalPort => $callbackport,
  936. Type => SOCK_STREAM, Reuse => 1, Listen => SOMAXCONN);
  937. if (!($server->{__daemon})) {
  938. Log3 $name, 1, "HMCCURPCPROC: [$name] Can't create RPC callback server $clkey on port $callbackport. Port in use?";
  939. return undef;
  940. }
  941. return $server;
  942. }
  943. # Create XML RPC server
  944. $server = RPC::XML::Server->new (port => $callbackport);
  945. if (!ref($server)) {
  946. Log3 $name, 1, "HMCCURPCPROC: [$name] Can't create RPC callback server $clkey on port $callbackport. Port in use?";
  947. return undef;
  948. }
  949. Log3 $name, 2, "HMCCURPCPROC: [$name] Callback server $clkey created. Listening on port $callbackport";
  950. # Callback for events
  951. Log3 $name, 4, "HMCCURPCPROC: [$name] Adding callback for events for server $clkey";
  952. $server->add_method (
  953. { name=>"event",
  954. signature=> ["string string string string string","string string string string int",
  955. "string string string string double","string string string string boolean",
  956. "string string string string i4"],
  957. code=>\&HMCCURPCPROC_EventCB
  958. }
  959. );
  960. # Callback for new devices
  961. Log3 $name, 4, "HMCCURPCPROC: [$name] Adding callback for new devices for server $clkey";
  962. $server->add_method (
  963. { name=>"newDevices",
  964. signature=>["string string array"],
  965. code=>\&HMCCURPCPROC_NewDevicesCB
  966. }
  967. );
  968. # Callback for deleted devices
  969. Log3 $name, 4, "HMCCURPCPROC: [$name] Adding callback for deleted devices for server $clkey";
  970. $server->add_method (
  971. { name=>"deleteDevices",
  972. signature=>["string string array"],
  973. code=>\&HMCCURPCPROC_DeleteDevicesCB
  974. }
  975. );
  976. # Callback for modified devices
  977. Log3 $name, 4, "HMCCURPCPROC: [$name] Adding callback for modified devices for server $clkey";
  978. $server->add_method (
  979. { name=>"updateDevice",
  980. signature=>["string string string int", "string string string i4"],
  981. code=>\&HMCCURPCPROC_UpdateDeviceCB
  982. }
  983. );
  984. # Callback for replaced devices
  985. Log3 $name, 4, "HMCCURPCPROC: [$name] Adding callback for replaced devices for server $clkey";
  986. $server->add_method (
  987. { name=>"replaceDevice",
  988. signature=>["string string string string"],
  989. code=>\&HMCCURPCPROC_ReplaceDeviceCB
  990. }
  991. );
  992. # Callback for readded devices
  993. Log3 $name, 4, "HMCCURPCPROC: [$name] Adding callback for readded devices for server $clkey";
  994. $server->add_method (
  995. { name=>"readdedDevice",
  996. signature=>["string string array"],
  997. code=>\&HMCCURPCPROC_ReaddDeviceCB
  998. }
  999. );
  1000. # Dummy implementation, always return an empty array
  1001. Log3 $name, 4, "HMCCURPCPROC: [$name] Adding callback for list devices for server $clkey";
  1002. $server->add_method (
  1003. { name=>"listDevices",
  1004. signature=>["array string"],
  1005. code=>\&HMCCURPCPROC_ListDevicesCB
  1006. }
  1007. );
  1008. return $server;
  1009. }
  1010. ######################################################################
  1011. # Start RPC server process
  1012. # Return (State, Msg)
  1013. ######################################################################
  1014. sub HMCCURPCPROC_StartRPCServer ($)
  1015. {
  1016. my ($hash) = @_;
  1017. my $name = $hash->{NAME};
  1018. my $hmccu_hash = $hash->{IODev};
  1019. # Local IP address and callback ID should be set during device definition
  1020. return (0, "Local address and/or callback ID not defined")
  1021. if (!exists ($hash->{hmccu}{localaddr}) || !exists ($hash->{rpcid}));
  1022. # Check if RPC server is already running
  1023. return (0, "RPC server already running") if (HMCCURPCPROC_CheckProcessState ($hash, 'running'));
  1024. # Get parameters and attributes
  1025. my %procpar;
  1026. my $localaddr = HMCCURPCPROC_GetAttribute ($hash, undef, 'rpcserveraddr', $hash->{hmccu}{localaddr});
  1027. my $rpcserverport = HMCCURPCPROC_GetAttribute ($hash, 'rpcServerPort', 'rpcserverport', $HMCCURPCPROC_SERVER_PORT);
  1028. my $evttimeout = HMCCURPCPROC_GetAttribute ($hash, 'rpcEventTimeout', 'rpcevtimeout', $HMCCURPCPROC_TIMEOUT_EVENT);
  1029. my $ccunum = $hash->{CCUNum};
  1030. my $rpcport = $hash->{rpcport};
  1031. my $serveraddr = HMCCU_GetRPCServerInfo ($hmccu_hash, $rpcport, 'host');
  1032. my $interface = HMCCU_GetRPCServerInfo ($hmccu_hash, $rpcport, 'name');
  1033. my $clkey = 'CB'.$rpcport.$hash->{rpcid};
  1034. $hash->{hmccu}{localaddr} = $localaddr;
  1035. # Store parameters for child process
  1036. $procpar{socktimeout} = AttrVal ($name, 'rpcWriteTimeout', $HMCCURPCPROC_TIMEOUT_WRITE);
  1037. $procpar{conntimeout} = AttrVal ($name, 'rpcConnTimeout', $HMCCURPCPROC_TIMEOUT_CONNECTION);
  1038. $procpar{acctimeout} = AttrVal ($name, 'rpcAcceptTimeout', $HMCCURPCPROC_TIMEOUT_ACCEPT);
  1039. $procpar{evttimeout} = AttrVal ($name, 'rpcEventTimeout', $HMCCURPCPROC_TIMEOUT_EVENT);
  1040. $procpar{queuesize} = AttrVal ($name, 'rpcQueueSize', $HMCCURPCPROC_MAX_QUEUESIZE);
  1041. $procpar{queuesend} = AttrVal ($name, 'rpcQueueSend', $HMCCURPCPROC_MAX_QUEUESEND);
  1042. $procpar{statistics} = AttrVal ($name, 'rpcStatistics', $HMCCURPCPROC_STATISTICS);
  1043. $procpar{maxioerrors} = AttrVal ($name, 'rpcMaxIOErrors', $HMCCURPCPROC_MAX_IOERRORS);
  1044. $procpar{evttimeout} = AttrVal ($name, 'rpcEventTimeout', $HMCCURPCPROC_TIMEOUT_EVENT);
  1045. $procpar{ccuflags} = AttrVal ($name, 'ccuflags', 'null');
  1046. $procpar{interface} = $interface;
  1047. $procpar{flags} = HMCCU_GetRPCServerInfo ($hmccu_hash, $rpcport, 'flags');
  1048. $procpar{type} = HMCCU_GetRPCServerInfo ($hmccu_hash, $rpcport, 'type');
  1049. $procpar{name} = $name;
  1050. $procpar{clkey} = $clkey;
  1051. my @eventtypes = ("EV", "ND", "DD", "RD", "RA", "UD", "IN", "EX", "SL", "TO");
  1052. # Reset state of server processes
  1053. $hash->{hmccu}{rpc}{state} = 'inactive';
  1054. # Create socket pair for communication between RPC server process and FHEM process
  1055. my ($sockchild, $sockparent);
  1056. return (0, "Can't create I/O socket pair")
  1057. if (!socketpair ($sockchild, $sockparent, AF_UNIX, SOCK_STREAM, PF_UNSPEC));
  1058. $sockchild->autoflush (1);
  1059. $sockparent->autoflush (1);
  1060. $hash->{hmccu}{sockparent} = $sockparent;
  1061. $hash->{hmccu}{sockchild} = $sockchild;
  1062. # Enable FHEM I/O
  1063. my $pid = $$;
  1064. $hash->{FD} = fileno $sockchild;
  1065. $selectlist{"RPC.$name.$pid"} = $hash;
  1066. # Initialize RPC server
  1067. my $err = '';
  1068. my %srvprocpar;
  1069. my $callbackport = $rpcserverport+$rpcport+($ccunum*10);
  1070. # Start RPC server process
  1071. my $rpcpid = fhemFork ();
  1072. if (!defined ($rpcpid)) {
  1073. close ($sockparent);
  1074. close ($sockchild);
  1075. return (0, "Can't create RPC server process for interface $interface");
  1076. }
  1077. if (!$rpcpid) {
  1078. # Child process, only needs parent socket
  1079. HMCCURPCPROC_HandleConnection ($rpcport, $callbackport, $sockparent, \%procpar);
  1080. # Exit child process
  1081. close ($sockparent);
  1082. close ($sockchild);
  1083. exit (0);
  1084. }
  1085. # Parent process
  1086. Log3 $name, 2, "HMCCURPCPROC: [$name] RPC server process started for interface $interface with PID=$rpcpid";
  1087. # Store process parameters
  1088. $hash->{hmccu}{rpc}{clkey} = $clkey;
  1089. $hash->{hmccu}{rpc}{cbport} = $callbackport;
  1090. $hash->{hmccu}{rpc}{pid} = $rpcpid;
  1091. $hash->{hmccu}{rpc}{state} = 'initialized';
  1092. # Reset statistic counter
  1093. foreach my $et (@eventtypes) {
  1094. $hash->{hmccu}{rpc}{rec}{$et} = 0;
  1095. $hash->{hmccu}{rpc}{snd}{$et} = 0;
  1096. }
  1097. $hash->{hmccu}{rpc}{sumdelay} = 0;
  1098. $hash->{RPCPID} = $rpcpid;
  1099. # Trigger Timer function for checking successful RPC start
  1100. # Timer will be removed before execution if event 'IN' is reveived
  1101. InternalTimer (gettimeofday()+$HMCCURPCPROC_INIT_INTERVAL3, "HMCCURPCPROC_IsRPCServerRunning",
  1102. $hash, 0);
  1103. HMCCURPCPROC_SetRPCState ($hash, "starting", "RPC server starting", 1);
  1104. DoTrigger ($name, "RPC server starting");
  1105. return (1, undef);
  1106. }
  1107. ######################################################################
  1108. # Set overall status if all RPC servers are running and update all
  1109. # FHEM devices.
  1110. # Return (State, updated devices, failed updates)
  1111. ######################################################################
  1112. sub HMCCURPCPROC_RPCServerStarted ($)
  1113. {
  1114. my ($hash) = @_;
  1115. my $name = $hash->{NAME};
  1116. my $hmccu_hash = $hash->{IODev};
  1117. my $clkey = 'CB'.$hash->{rpcport}.$hash->{rpcid};
  1118. my $ifname = $hash->{rpcinterface};
  1119. # Check if RPC servers are running. Set overall status
  1120. if (HMCCURPCPROC_CheckProcessState ($hash, 'running')) {
  1121. $hash->{hmccu}{rpcstarttime} = time ();
  1122. HMCCURPCPROC_SetState ($hash, "OK");
  1123. if ($hmccu_hash->{hmccu}{interfaces}{$ifname}{manager} eq 'HMCCURPCPROC') {
  1124. my ($c_ok, $c_err) = HMCCU_UpdateClients ($hmccu_hash, '.*', 'Attr', 0, $ifname);
  1125. Log3 $name, 2, "HMCCURPCPROC: [$name] Updated devices. Success=$c_ok Failed=$c_err";
  1126. }
  1127. RemoveInternalTimer ($hash);
  1128. DoTrigger ($name, "RPC server $clkey running");
  1129. return 1;
  1130. }
  1131. return 0;
  1132. }
  1133. ######################################################################
  1134. # Cleanup if RPC server stopped
  1135. ######################################################################
  1136. sub HMCCURPCPROC_RPCServerStopped ($)
  1137. {
  1138. my ($hash) = @_;
  1139. my $name = $hash->{NAME};
  1140. my $clkey = 'CB'.$hash->{rpcport}.$hash->{rpcid};
  1141. HMCCURPCPROC_CleanupProcess ($hash);
  1142. HMCCURPCPROC_CleanupIO ($hash);
  1143. HMCCURPCPROC_ResetRPCState ($hash);
  1144. HMCCURPCPROC_SetState ($hash, "OK");
  1145. RemoveInternalTimer ($hash);
  1146. DoTrigger ($name, "RPC server $clkey stopped");
  1147. }
  1148. ######################################################################
  1149. # Stop I/O Handling
  1150. ######################################################################
  1151. sub HMCCURPCPROC_CleanupIO ($)
  1152. {
  1153. my ($hash) = @_;
  1154. my $name = $hash->{NAME};
  1155. my $pid = $$;
  1156. if (exists ($selectlist{"RPC.$name.$pid"})) {
  1157. Log3 $name, 2, "HMCCURPCPROC: [$name] Stop I/O handling";
  1158. delete $selectlist{"RPC.$name.$pid"};
  1159. delete $hash->{FD} if (defined ($hash->{FD}));
  1160. }
  1161. if (defined ($hash->{hmccu}{sockchild})) {
  1162. Log3 $name, 3, "HMCCURPCPROC: [$name] Close child socket";
  1163. $hash->{hmccu}{sockchild}->close ();
  1164. delete $hash->{hmccu}{sockchild};
  1165. }
  1166. if (defined ($hash->{hmccu}{sockparent})) {
  1167. Log3 $name, 3, "HMCCURPCPROC: [$name] Close parent socket";
  1168. $hash->{hmccu}{sockparent}->close ();
  1169. delete $hash->{hmccu}{sockparent};
  1170. }
  1171. }
  1172. ######################################################################
  1173. # Terminate RPC server process by sending an INT signal.
  1174. # Return 0 if RPC server not running.
  1175. ######################################################################
  1176. sub HMCCURPCPROC_TerminateProcess ($)
  1177. {
  1178. my ($hash) = @_;
  1179. my $name = $hash->{NAME};
  1180. my $clkey = 'CB'.$hash->{rpcport}.$hash->{rpcid};
  1181. # return 0 if ($hash->{hmccu}{rpc}{state} eq 'inactive');
  1182. my $pid = $hash->{hmccu}{rpc}{pid};
  1183. if (defined ($pid) && kill (0, $pid)) {
  1184. HMCCURPCPROC_SetRPCState ($hash, 'stopping', "Sending signal INT to RPC server process $clkey with PID=$pid", 2);
  1185. kill ('INT', $pid);
  1186. return 1;
  1187. }
  1188. else {
  1189. HMCCURPCPROC_SetRPCState ($hash, 'inactive', "RPC server process $clkey not runnning", 1);
  1190. return 0;
  1191. }
  1192. }
  1193. ######################################################################
  1194. # Cleanup inactive RPC server process.
  1195. # Return 0 if process is running.
  1196. ######################################################################
  1197. sub HMCCURPCPROC_CleanupProcess ($)
  1198. {
  1199. my ($hash) = @_;
  1200. my $name = $hash->{NAME};
  1201. my $clkey = 'CB'.$hash->{rpcport}.$hash->{rpcid};
  1202. # return 1 if ($hash->{hmccu}{rpc}{state} eq 'inactive');
  1203. my $pid = $hash->{hmccu}{rpc}{pid};
  1204. if (defined ($pid) && kill (0, $pid)) {
  1205. Log3 $name, 1, "HMCCURPCPROC: [$name] Process $clkey with PID=$pid".
  1206. " still running. Killing it.";
  1207. kill ('KILL', $pid);
  1208. sleep (1);
  1209. if (kill (0, $pid)) {
  1210. Log3 $name, 1, "HMCCURPCPROC: [$name] Can't kill process $clkey with PID=$pid";
  1211. return 0;
  1212. }
  1213. }
  1214. HMCCURPCPROC_SetRPCState ($hash, 'inactive', "RPC server process $clkey deleted", 2);
  1215. $hash->{hmccu}{rpc}{pid} = undef;
  1216. return 1;
  1217. }
  1218. ######################################################################
  1219. # Check if RPC server process is in specified state.
  1220. # Parameter state is a regular expression. Valid states are:
  1221. # inactive
  1222. # starting
  1223. # working
  1224. # registered
  1225. # running
  1226. # stopping
  1227. # If state is 'running' the process is checked by calling kill() with
  1228. # signal 0.
  1229. ######################################################################
  1230. sub HMCCURPCPROC_CheckProcessState ($$)
  1231. {
  1232. my ($hash, $state) = @_;
  1233. my $prcname = 'CB'.$hash->{rpcport}.$hash->{rpcid};
  1234. my $pstate = $hash->{hmccu}{rpc}{state};
  1235. if ($state eq 'running' || $state eq '.*') {
  1236. my $pid = $hash->{hmccu}{rpc}{pid};
  1237. return (defined ($pid) && $pid != 0 && kill (0, $pid) && $pstate =~ /$state/) ? $pid : 0
  1238. }
  1239. else {
  1240. return ($pstate =~ /$state/) ? 1 : 0;
  1241. }
  1242. }
  1243. ######################################################################
  1244. # Timer function to check if RPC server process is running.
  1245. # Call Housekeeping() if process is not running.
  1246. ######################################################################
  1247. sub HMCCURPCPROC_IsRPCServerRunning ($)
  1248. {
  1249. my ($hash, $cleanup) = @_;
  1250. my $name = $hash->{NAME};
  1251. Log3 $name, 2, "HMCCURPCPROC: [$name] Checking if RPC server process is running";
  1252. if (!HMCCURPCPROC_CheckProcessState ($hash, 'running')) {
  1253. Log3 $name, 1, "HMCCURPCPROC: [$name] RPC server process not running. Cleaning up";
  1254. HMCCURPCPROC_Housekeeping ($hash);
  1255. return 0;
  1256. }
  1257. Log3 $name, 2, "HMCCURPCPROC: [$name] RPC server process running";
  1258. return 1;
  1259. }
  1260. ######################################################################
  1261. # Cleanup RPC server environment.
  1262. ######################################################################
  1263. sub HMCCURPCPROC_Housekeeping ($)
  1264. {
  1265. my ($hash) = @_;
  1266. my $name = $hash->{NAME};
  1267. Log3 $name, 1, "HMCCURPCPROC: [$name] Housekeeping called. Cleaning up RPC environment";
  1268. # Deregister callback URLs in CCU
  1269. HMCCURPCPROC_DeRegisterCallback ($hash, 0);
  1270. # Terminate process by sending signal INT
  1271. sleep (2) if (HMCCURPCPROC_TerminateProcess ($hash));
  1272. # Next call will cleanup IO, processes and reset RPC state
  1273. HMCCURPCPROC_RPCServerStopped ($hash);
  1274. }
  1275. ######################################################################
  1276. # Stop RPC server processes.
  1277. ######################################################################
  1278. sub HMCCURPCPROC_StopRPCServer ($)
  1279. {
  1280. my ($hash) = @_;
  1281. my $name = $hash->{NAME};
  1282. my $clkey = 'CB'.$hash->{rpcport}.$hash->{rpcid};
  1283. if (HMCCURPCPROC_CheckProcessState ($hash, 'running')) {
  1284. Log3 $name, 1, "HMCCURPCPROC: [$name] Stopping RPC server $clkey";
  1285. HMCCURPCPROC_SetState ($hash, "busy");
  1286. # Deregister callback URLs in CCU
  1287. my ($rc, $err) = HMCCURPCPROC_DeRegisterCallback ($hash, 0);
  1288. Log3 $name, 1, "HMCCURPCPROC: [$name] $err" if (!$rc);
  1289. # Stop RPC server process
  1290. HMCCURPCPROC_TerminateProcess ($hash);
  1291. # Trigger timer function for checking successful RPC stop
  1292. # Timer will be removed wenn receiving EX event from RPC server process
  1293. InternalTimer (gettimeofday()+$HMCCURPCPROC_INIT_INTERVAL2, "HMCCURPCPROC_Housekeeping",
  1294. $hash, 0);
  1295. # Give process the chance to terminate
  1296. sleep (1);
  1297. return 1;
  1298. }
  1299. else {
  1300. Log3 $name, 2, "HMCCURPCPROC: [$name] Found no running processes. Cleaning up ...";
  1301. HMCCURPCPROC_Housekeeping ($hash);
  1302. return 0;
  1303. }
  1304. }
  1305. ######################################################################
  1306. # Send RPC request to CCU.
  1307. # Supports XML and BINRPC requests.
  1308. # Return response or undef on error.
  1309. ######################################################################
  1310. sub HMCCURPCPROC_SendRequest ($@)
  1311. {
  1312. my ($hash, $request, @param) = @_;
  1313. my $name = $hash->{NAME};
  1314. my $hmccu_hash = $hash->{IODev};
  1315. my $port = $hash->{rpcport};
  1316. my $rc;
  1317. if (HMCCU_IsRPCType ($hmccu_hash, $port, 'A')) {
  1318. my $clurl = HMCCU_GetRPCServerInfo ($hmccu_hash, $port, 'url');
  1319. return HMCCU_Log ($hash, 2, "Can't get client URL for port $port", undef)
  1320. if (!defined ($clurl));
  1321. Log3 $name, 4, "HMCCURPCPROC: [$name] Send ASCII RPC request $request to $clurl";
  1322. my $rpcclient = RPC::XML::Client->new ($clurl);
  1323. $rc = $rpcclient->simple_request ($request, @param);
  1324. Log3 $name, 2, "HMCCURPCPROC: [$name] RPC request error ".$RPC::XML::ERROR if (!defined ($rc));
  1325. }
  1326. elsif (HMCCU_IsRPCType ($hmccu_hash, $port, 'B')) {
  1327. my $serveraddr = HMCCU_GetRPCServerInfo ($hmccu_hash, $port, 'host');
  1328. return HMCCU_Log ($hash, 2, "Can't get server address for port $port", undef)
  1329. if (!defined ($serveraddr));
  1330. my $ccuflags = AttrVal ($name, 'ccuflags', 'null');
  1331. my $verbose = GetVerbose ($name);
  1332. Log3 $name, 4, "HMCCURPCPROC: [$name] Send binary RPC request $request to $serveraddr:$port";
  1333. my $encreq = HMCCURPCPROC_EncodeRequest ($request, \@param);
  1334. return HMCCU_Log ($hash, 2, "Error encoding binary request", undef) if ($encreq eq '');
  1335. # auto-flush on socket
  1336. $| = 1;
  1337. # create a connecting socket
  1338. my $socket = new IO::Socket::INET (PeerHost => $serveraddr, PeerPort => $port,
  1339. Proto => 'tcp');
  1340. return HMCCU_Log ($hash, 2, "Can't create socket for $serveraddr:$port", undef) if (!$socket);
  1341. my $size = $socket->send ($encreq);
  1342. if (defined ($size)) {
  1343. my $encresp = <$socket>;
  1344. $socket->close ();
  1345. if (defined ($encresp)) {
  1346. if ($ccuflags =~ /logEvents/ && $verbose >= 4) {
  1347. Log3 $name, 4, "HMCCURPCPROC: [$name] Response";
  1348. HMCCURPCPROC_HexDump ($name, $encresp);
  1349. }
  1350. my ($response, $err) = HMCCURPCPROC_DecodeResponse ($encresp);
  1351. return $response;
  1352. }
  1353. else {
  1354. return '';
  1355. }
  1356. }
  1357. $socket->close ();
  1358. }
  1359. else {
  1360. Log3 $name, 2, "HMCCURPCPROC: [$name] Unknown RPC server type";
  1361. }
  1362. return $rc;
  1363. }
  1364. ######################################################################
  1365. # Process binary RPC request
  1366. ######################################################################
  1367. sub HMCCURPCPROC_ProcessRequest ($$)
  1368. {
  1369. my ($server, $connection) = @_;
  1370. my $name = $server->{hmccu}{name};
  1371. my $clkey = $server->{hmccu}{clkey};
  1372. my @methodlist = ('listDevices', 'listMethods', 'system.multicall');
  1373. my $verbose = GetVerbose ($name);
  1374. # Read request
  1375. my $request = '';
  1376. while (my $packet = <$connection>) {
  1377. $request .= $packet;
  1378. }
  1379. return if (!defined ($request) || $request eq '');
  1380. if ($server->{hmccu}{ccuflags} =~ /logEvents/ && $verbose >= 4) {
  1381. Log3 $name, 4, "CCURPC: [$name] $clkey raw request:";
  1382. HMCCURPCPROC_HexDump ($name, $request);
  1383. }
  1384. # Decode request
  1385. my ($method, $params) = HMCCURPCPROC_DecodeRequest ($request);
  1386. return if (!defined ($method));
  1387. Log3 $name, 4, "CCURPC: [$name] request method = $method";
  1388. if ($method eq 'listmethods') {
  1389. $connection->send (HMCCURPCPROC_EncodeResponse ($BINRPC_ARRAY, \@methodlist));
  1390. }
  1391. elsif ($method eq 'listdevices') {
  1392. HMCCURPCPROC_ListDevicesCB ($server, $clkey);
  1393. $connection->send (HMCCURPCPROC_EncodeResponse ($BINRPC_ARRAY, undef));
  1394. }
  1395. elsif ($method eq 'system.multicall') {
  1396. return if (ref ($params) ne 'ARRAY');
  1397. my $a = $$params[0];
  1398. foreach my $s (@$a) {
  1399. next if (!exists ($s->{methodName}) || !exists ($s->{params}));
  1400. next if ($s->{methodName} ne 'event');
  1401. next if (scalar (@{$s->{params}}) < 4);
  1402. HMCCURPCPROC_EventCB ($server, $clkey,
  1403. ${$s->{params}}[1], ${$s->{params}}[2], ${$s->{params}}[3]);
  1404. Log3 $name, 4, "CCURPC: [$name] Event ".${$s->{params}}[1]." ".${$s->{params}}[2]." "
  1405. .${$s->{params}}[3];
  1406. }
  1407. }
  1408. }
  1409. ######################################################################
  1410. # Subprocess function for handling incoming RPC requests
  1411. ######################################################################
  1412. sub HMCCURPCPROC_HandleConnection ($$$$)
  1413. {
  1414. my ($port, $callbackport, $sockparent, $procpar) = @_;
  1415. my $name = $procpar->{name};
  1416. my $iface = $procpar->{interface};
  1417. my $prot = $procpar->{type};
  1418. my $evttimeout = $procpar->{evttimeout};
  1419. my $conntimeout = $procpar->{conntimeout};
  1420. my $acctimeout = $procpar->{acctimeout};
  1421. my $socktimeout = $procpar->{socktimeout};
  1422. my $maxsnd = $procpar->{queuesend};
  1423. my $maxioerrors = $procpar->{maxioerrors};
  1424. my $clkey = $procpar->{clkey};
  1425. my $ioerrors = 0;
  1426. my $sioerrors = 0;
  1427. my $run = 1;
  1428. my $pid = $$;
  1429. my @eventtypes = ("EV", "ND", "DD", "RD", "RA", "UD", "IN", "EX", "SL", "TO");
  1430. # Initialize RPC server
  1431. Log3 $name, 2, "CCURPC: [$name] Initializing RPC server $clkey for interface $iface";
  1432. my $rpcsrv = HMCCURPCPROC_InitRPCServer ($name, $clkey, $callbackport, $prot);
  1433. if (!defined ($rpcsrv)) {
  1434. Log3 $name, 1, "CCURPC: [$name] Can't initialize RPC server $clkey for interface $iface";
  1435. return;
  1436. }
  1437. if (!($rpcsrv->{__daemon})) {
  1438. Log3 $name, 1, "CCURPC: [$name] Server socket not found for port $port";
  1439. return;
  1440. }
  1441. # Event queue
  1442. my @queue = ();
  1443. # Store RPC server parameters
  1444. $rpcsrv->{hmccu}{name} = $name;
  1445. $rpcsrv->{hmccu}{clkey} = $clkey;
  1446. $rpcsrv->{hmccu}{eventqueue} = \@queue;
  1447. $rpcsrv->{hmccu}{queuesize} = $procpar->{queuesize};
  1448. $rpcsrv->{hmccu}{sockparent} = $sockparent;
  1449. $rpcsrv->{hmccu}{statistics} = $procpar->{statistics};
  1450. $rpcsrv->{hmccu}{ccuflags} = $procpar->{ccuflags};
  1451. $rpcsrv->{hmccu}{flags} = $procpar->{flags};
  1452. $rpcsrv->{hmccu}{evttime} = time ();
  1453. # Initialize statistic counters
  1454. foreach my $et (@eventtypes) {
  1455. $rpcsrv->{hmccu}{rec}{$et} = 0;
  1456. $rpcsrv->{hmccu}{snd}{$et} = 0;
  1457. }
  1458. $rpcsrv->{hmccu}{rec}{total} = 0;
  1459. $rpcsrv->{hmccu}{snd}{total} = 0;
  1460. # Signal handler
  1461. $SIG{INT} = sub { $run = 0; Log3 $name, 2, "CCURPC: [$name] $clkey received signal INT"; };
  1462. HMCCURPCPROC_Write ($rpcsrv, "SL", $clkey, $pid);
  1463. Log3 $name, 2, "CCURPC: [$name] $clkey accepting connections. PID=$pid";
  1464. $rpcsrv->{__daemon}->timeout ($acctimeout) if ($acctimeout > 0.0);
  1465. while ($run) {
  1466. if ($evttimeout > 0) {
  1467. my $difftime = time()-$rpcsrv->{hmccu}{evttime};
  1468. HMCCURPCPROC_Write ($rpcsrv, "TO", $clkey, $difftime) if ($difftime >= $evttimeout);
  1469. }
  1470. # Send queue entries to parent process
  1471. if (scalar (@queue) > 0) {
  1472. Log3 $name, 4, "CCURPC: [$name] RPC server $clkey sending data to FHEM";
  1473. my ($c, $m) = HMCCURPCPROC_SendQueue ($sockparent, $socktimeout, \@queue, $maxsnd);
  1474. if ($c < 0) {
  1475. $ioerrors++;
  1476. $sioerrors++;
  1477. if ($ioerrors >= $maxioerrors || $maxioerrors == 0) {
  1478. Log3 $name, 2, "CCURPC: [$name] Sending data to FHEM failed $ioerrors times. $m";
  1479. $ioerrors = 0;
  1480. }
  1481. }
  1482. }
  1483. # Next statement blocks for rpcAcceptTimeout seconds
  1484. Log3 $name, 5, "CCURPC: [$name] RPC server $clkey accepting connections";
  1485. my $connection = $rpcsrv->{__daemon}->accept ();
  1486. next if (! $connection);
  1487. last if (! $run);
  1488. $connection->timeout ($conntimeout) if ($conntimeout > 0.0);
  1489. Log3 $name, 4, "CCURPC: [$name] RPC server $clkey processing request";
  1490. if ($prot eq 'A') {
  1491. $rpcsrv->process_request ($connection);
  1492. }
  1493. else {
  1494. HMCCURPCPROC_ProcessRequest ($rpcsrv, $connection);
  1495. }
  1496. shutdown ($connection, 2);
  1497. close ($connection);
  1498. undef $connection;
  1499. }
  1500. Log3 $name, 1, "CCURPC: [$name] RPC server $clkey stopped handling connections. PID=$pid";
  1501. close ($rpcsrv->{__daemon}) if ($prot eq 'B');
  1502. # Send statistic info
  1503. HMCCURPCPROC_WriteStats ($rpcsrv, $clkey);
  1504. # Send exit information
  1505. HMCCURPCPROC_Write ($rpcsrv, "EX", $clkey, "SHUTDOWN|$pid");
  1506. # Send queue entries to parent process. Resend on error to ensure that EX event is sent
  1507. my ($c, $m) = HMCCURPCPROC_SendQueue ($sockparent, $socktimeout, \@queue, 0);
  1508. if ($c < 0) {
  1509. Log3 $name, 4, "CCURPC: [$name] Sending data to FHEM failed. $m";
  1510. # Wait 1 second and try again
  1511. sleep (1);
  1512. HMCCURPCPROC_SendQueue ($sockparent, $socktimeout, \@queue, 0);
  1513. }
  1514. # Log statistic counters
  1515. foreach my $et (@eventtypes) {
  1516. Log3 $name, 4, "CCURPC: [$name] $clkey event type = $et: ".$rpcsrv->{hmccu}{rec}{$et};
  1517. }
  1518. Log3 $name, 2, "CCURPC: [$name] Number of I/O errors = $sioerrors";
  1519. return;
  1520. }
  1521. ######################################################################
  1522. # Send queue data to parent process.
  1523. # Return number of queue elements sent to parent process or
  1524. # (-1, errormessage) on error.
  1525. ######################################################################
  1526. sub HMCCURPCPROC_SendQueue ($$$$)
  1527. {
  1528. my ($sockparent, $socktimeout, $queue, $maxsnd) = @_;
  1529. my $fd = fileno ($sockparent);
  1530. my $msg = '';
  1531. my $win = '';
  1532. vec ($win, $fd, 1) = 1;
  1533. my $nf = select (undef, $win, undef, $socktimeout);
  1534. if ($nf <= 0) {
  1535. $msg = $nf == 0 ? "select found no reader" : $!;
  1536. return (-1, $msg);
  1537. }
  1538. my $sndcnt = 0;
  1539. while (my $snddata = shift @{$queue}) {
  1540. my ($bytes, $err) = HMCCURPCPROC_SendData ($sockparent, $snddata);
  1541. if ($bytes == 0) {
  1542. # Put item back in queue
  1543. unshift @{$queue}, $snddata;
  1544. $msg = $err;
  1545. $sndcnt = -1;
  1546. last;
  1547. }
  1548. $sndcnt++;
  1549. last if ($sndcnt == $maxsnd && $maxsnd > 0);
  1550. }
  1551. return ($sndcnt, $msg);
  1552. }
  1553. ######################################################################
  1554. # Check if file descriptor is writeable and write data.
  1555. # Return number of bytes written and error message.
  1556. ######################################################################
  1557. sub HMCCURPCPROC_SendData ($$)
  1558. {
  1559. my ($sockparent, $data) = @_;
  1560. my $bytes = 0;
  1561. my $err = '';
  1562. my $size = pack ("N", length ($data));
  1563. my $msg = $size . $data;
  1564. $bytes = syswrite ($sockparent, $msg);
  1565. if (!defined ($bytes)) {
  1566. $err = $!;
  1567. $bytes = 0;
  1568. }
  1569. elsif ($bytes != length ($msg)) {
  1570. $err = "Sent incomplete data";
  1571. }
  1572. return ($bytes, $err);
  1573. }
  1574. ######################################################################
  1575. # Check if file descriptor is readable and read data.
  1576. # Return data and error message.
  1577. ######################################################################
  1578. sub HMCCURPCPROC_ReceiveData ($$)
  1579. {
  1580. my ($fh, $socktimeout) = @_;
  1581. my $header;
  1582. my $data;
  1583. my $err = '';
  1584. # Check if data is available
  1585. my $fd = fileno ($fh);
  1586. my $rin = '';
  1587. vec ($rin, $fd, 1) = 1;
  1588. my $nfound = select ($rin, undef, undef, $socktimeout);
  1589. if ($nfound < 0) {
  1590. return (undef, $!);
  1591. }
  1592. elsif ($nfound == 0) {
  1593. return (undef, "read: no data");
  1594. }
  1595. # Read datagram size
  1596. my $sbytes = sysread ($fh, $header, 4);
  1597. if (!defined ($sbytes)) {
  1598. return (undef, $!);
  1599. }
  1600. elsif ($sbytes != 4) {
  1601. return (undef, "read: short header");
  1602. }
  1603. # Read datagram
  1604. my $size = unpack ('N', $header);
  1605. my $bytes = sysread ($fh, $data, $size);
  1606. if (!defined ($bytes)) {
  1607. return (undef, $!);
  1608. }
  1609. elsif ($bytes != $size) {
  1610. return (undef, "read: incomplete data");
  1611. }
  1612. return ($data, $err);
  1613. }
  1614. ######################################################################
  1615. # Write event into queue.
  1616. ######################################################################
  1617. sub HMCCURPCPROC_Write ($$$$)
  1618. {
  1619. my ($server, $et, $cb, $msg) = @_;
  1620. my $name = $server->{hmccu}{name};
  1621. if (defined ($server->{hmccu}{eventqueue})) {
  1622. my $queue = $server->{hmccu}{eventqueue};
  1623. my $ev = $et."|".$cb."|".$msg;
  1624. $server->{hmccu}{evttime} = time ();
  1625. if (defined ($server->{hmccu}{queuesize}) &&
  1626. scalar (@{$queue}) >= $server->{hmccu}{queuesize}) {
  1627. Log3 $name, 1, "CCURPC: [$name] $cb maximum queue size reached. Dropping event.";
  1628. return;
  1629. }
  1630. Log3 $name, 2, "CCURPC: [$name] event = $ev" if ($server->{hmccu}{ccuflags} =~ /logEvents/);
  1631. # Try to send events immediately. Put them in queue if send fails
  1632. my $rc = 0;
  1633. my $err = '';
  1634. if ($et ne 'ND' && $server->{hmccu}{ccuflags} !~ /queueEvents/) {
  1635. ($rc, $err) = HMCCURPCPROC_SendData ($server->{hmccu}{sockparent}, $ev);
  1636. Log3 $name, 3, "CCURPC: [$name] SendData $ev $err" if ($rc == 0);
  1637. }
  1638. push (@{$queue}, $ev) if ($rc == 0);
  1639. # Event statistics
  1640. $server->{hmccu}{rec}{$et}++;
  1641. $server->{hmccu}{rec}{total}++;
  1642. $server->{hmccu}{snd}{$et}++;
  1643. $server->{hmccu}{snd}{total}++;
  1644. HMCCURPCPROC_WriteStats ($server, $cb)
  1645. if ($server->{hmccu}{snd}{total} % $server->{hmccu}{statistics} == 0);
  1646. }
  1647. }
  1648. ######################################################################
  1649. # Write statistics
  1650. ######################################################################
  1651. sub HMCCURPCPROC_WriteStats ($$)
  1652. {
  1653. my ($server, $clkey) = @_;
  1654. my $name = $server->{hmccu}{name};
  1655. my @eventtypes = ("EV", "ND", "DD", "RD", "RA", "UD", "IN", "EX", "SL", "TO");
  1656. if (defined ($server->{hmccu}{eventqueue})) {
  1657. my $queue = $server->{hmccu}{eventqueue};
  1658. # Send statistic info
  1659. my $st = $server->{hmccu}{snd}{total};
  1660. foreach my $et (@eventtypes) {
  1661. $st .= '|'.$server->{hmccu}{snd}{$et};
  1662. $server->{hmccu}{snd}{$et} = 0;
  1663. }
  1664. Log3 $name, 4, "CCURPC: [$name] Event statistics = $st";
  1665. push (@{$queue}, "ST|$clkey|$st");
  1666. }
  1667. }
  1668. ######################################################################
  1669. # Helper functions
  1670. ######################################################################
  1671. ######################################################################
  1672. # Dump variable content as hex/ascii combination
  1673. ######################################################################
  1674. sub HMCCURPCPROC_HexDump ($$)
  1675. {
  1676. my ($name, $data) = @_;
  1677. my $offset = 0;
  1678. foreach my $chunk (unpack "(a16)*", $data) {
  1679. my $hex = unpack "H*", $chunk; # hexadecimal magic
  1680. $chunk =~ tr/ -~/./c; # replace unprintables
  1681. $hex =~ s/(.{1,8})/$1 /gs; # insert spaces
  1682. Log3 $name, 4, sprintf "0x%08x (%05u) %-*s %s", $offset, $offset, 36, $hex, $chunk;
  1683. $offset += 16;
  1684. }
  1685. }
  1686. ######################################################################
  1687. # Callback functions
  1688. ######################################################################
  1689. ######################################################################
  1690. # Callback for new devices
  1691. ######################################################################
  1692. sub HMCCURPCPROC_NewDevicesCB ($$$)
  1693. {
  1694. my ($server, $cb, $a) = @_;
  1695. my $name = $server->{hmccu}{name};
  1696. my $devcount = scalar (@$a);
  1697. Log3 $name, 2, "CCURPC: [$name] $cb NewDevice received $devcount device and channel specifications";
  1698. foreach my $dev (@$a) {
  1699. my $msg = '';
  1700. if ($dev->{ADDRESS} =~ /:[0-9]{1,2}$/) {
  1701. $msg = "C|".$dev->{ADDRESS}."|".$dev->{TYPE}."|".$dev->{VERSION}."|null|null";
  1702. }
  1703. else {
  1704. # Wired devices do not have a RX_MODE attribute
  1705. my $rx = exists ($dev->{RX_MODE}) ? $dev->{RX_MODE} : 'null';
  1706. $msg = "D|".$dev->{ADDRESS}."|".$dev->{TYPE}."|".$dev->{VERSION}."|".
  1707. $dev->{FIRMWARE}."|".$rx;
  1708. }
  1709. HMCCURPCPROC_Write ($server, "ND", $cb, $msg);
  1710. }
  1711. return;
  1712. }
  1713. ##################################################
  1714. # Callback for deleted devices
  1715. ##################################################
  1716. sub HMCCURPCPROC_DeleteDevicesCB ($$$)
  1717. {
  1718. my ($server, $cb, $a) = @_;
  1719. my $name = $server->{hmccu}{name};
  1720. my $devcount = scalar (@$a);
  1721. Log3 $name, 2, "CCURPC: [$name] $cb DeleteDevice received $devcount device addresses";
  1722. foreach my $dev (@$a) {
  1723. HMCCURPCPROC_Write ($server, "DD", $cb, $dev);
  1724. }
  1725. return;
  1726. }
  1727. ##################################################
  1728. # Callback for modified devices
  1729. ##################################################
  1730. sub HMCCURPCPROC_UpdateDeviceCB ($$$$)
  1731. {
  1732. my ($server, $cb, $devid, $hint) = @_;
  1733. my $name = $server->{hmccu}{name};
  1734. Log3 $name, 2, "CCURPC: [$name] $cb updated device $devid with hint $hint";
  1735. HMCCURPCPROC_Write ($server, "UD", $cb, $devid."|".$hint);
  1736. return;
  1737. }
  1738. ##################################################
  1739. # Callback for replaced devices
  1740. ##################################################
  1741. sub HMCCURPCPROC_ReplaceDeviceCB ($$$$)
  1742. {
  1743. my ($server, $cb, $devid1, $devid2) = @_;
  1744. my $name = $server->{hmccu}{name};
  1745. Log3 $name, 2, "CCURPC: [$name] $cb device $devid1 replaced by $devid2";
  1746. HMCCURPCPROC_Write ($server, "RD", $cb, $devid1."|".$devid2);
  1747. return;
  1748. }
  1749. ##################################################
  1750. # Callback for readded devices
  1751. ##################################################
  1752. sub HMCCURPCPROC_ReaddDevicesCB ($$$)
  1753. {
  1754. my ($server, $cb, $a) = @_;
  1755. my $name = $server->{hmccu}{name};
  1756. my $devcount = scalar (@$a);
  1757. Log3 $name, 2, "CCURPC: [$name] $cb ReaddDevice received $devcount device addresses";
  1758. foreach my $dev (@$a) {
  1759. HMCCURPCPROC_Write ($server, "RA", $cb, $dev);
  1760. }
  1761. return;
  1762. }
  1763. ##################################################
  1764. # Callback for handling CCU events
  1765. ##################################################
  1766. sub HMCCURPCPROC_EventCB ($$$$$)
  1767. {
  1768. my ($server, $cb, $devid, $attr, $val) = @_;
  1769. my $name = $server->{hmccu}{name};
  1770. my $etime = time ();
  1771. HMCCURPCPROC_Write ($server, "EV", $cb, $etime."|".$devid."|".$attr."|".$val);
  1772. # Never remove this statement!
  1773. return;
  1774. }
  1775. ##################################################
  1776. # Callback for list devices
  1777. ##################################################
  1778. sub HMCCURPCPROC_ListDevicesCB ($$)
  1779. {
  1780. my ($server, $cb) = @_;
  1781. my $name = $server->{hmccu}{name};
  1782. if ($server->{hmccu}{ccuflags} =~ /ccuInit/) {
  1783. $cb = "unknown" if (!defined ($cb));
  1784. Log3 $name, 1, "CCURPC: [$name] $cb ListDevices. Sending init to HMCCU";
  1785. HMCCURPCPROC_Write ($server, "IN", $cb, "INIT|1");
  1786. }
  1787. return RPC::XML::array->new ();
  1788. }
  1789. ######################################################################
  1790. # Binary RPC encoding functions
  1791. ######################################################################
  1792. ######################################################################
  1793. # Encode integer (type = 1)
  1794. ######################################################################
  1795. sub HMCCURPCPROC_EncInteger ($)
  1796. {
  1797. my ($v) = @_;
  1798. return pack ('Nl', $BINRPC_INTEGER, $v);
  1799. }
  1800. ######################################################################
  1801. # Encode bool (type = 2)
  1802. ######################################################################
  1803. sub HMCCURPCPROC_EncBool ($)
  1804. {
  1805. my ($v) = @_;
  1806. return pack ('NC', $BINRPC_BOOL, $v);
  1807. }
  1808. ######################################################################
  1809. # Encode string (type = 3)
  1810. # Input is string. Empty string = void
  1811. ######################################################################
  1812. sub HMCCURPCPROC_EncString ($)
  1813. {
  1814. my ($v) = @_;
  1815. return pack ('NN', $BINRPC_STRING, length ($v)).$v;
  1816. }
  1817. ######################################################################
  1818. # Encode name
  1819. ######################################################################
  1820. sub HMCCURPCPROC_EncName ($)
  1821. {
  1822. my ($v) = @_;
  1823. return pack ('N', length ($v)).$v;
  1824. }
  1825. ######################################################################
  1826. # Encode double (type = 4)
  1827. ######################################################################
  1828. sub HMCCURPCPROC_EncDouble ($)
  1829. {
  1830. my ($v) = @_;
  1831. # my $s = $v < 0 ? -1.0 : 1.0;
  1832. # my $l = $v != 0.0 ? log (abs($v))/log (2) : 0.0;
  1833. # my $f = $l;
  1834. #
  1835. # if ($l-int ($l) > 0) {
  1836. # $f = ($l < 0) ? -int (abs ($l)+1.0) : int ($l);
  1837. # }
  1838. # my $e = $f+1;
  1839. # my $m = int ($v*2**-$e*0x40000000);
  1840. my $m = 0;
  1841. my $e = 0;
  1842. if ($v != 0.0) {
  1843. $e = int(log(abs($v))/log(2.0))+1;
  1844. $m = int($v/(2**$e)*0x40000000);
  1845. }
  1846. return pack ('NNN', $BINRPC_DOUBLE, $m, $e);
  1847. }
  1848. ######################################################################
  1849. # Encode base64 (type = 17)
  1850. # Input is base64 encoded string
  1851. ######################################################################
  1852. sub HMCCURPCPROC_EncBase64 ($)
  1853. {
  1854. my ($v) = @_;
  1855. return pack ('NN', $BINRPC_DOUBLE, length ($v)).$v;
  1856. }
  1857. ######################################################################
  1858. # Encode array (type = 256)
  1859. # Input is array reference. Array must contain (type, value) pairs
  1860. ######################################################################
  1861. sub HMCCURPCPROC_EncArray ($)
  1862. {
  1863. my ($a) = @_;
  1864. my $r = '';
  1865. my $s = 0;
  1866. if (defined ($a)) {
  1867. while (my $t = shift @$a) {
  1868. my $e = shift @$a;
  1869. if ($e) {
  1870. $r .= HMCCURPCPROC_EncType ($t, $e);
  1871. $s++;
  1872. }
  1873. }
  1874. }
  1875. return pack ('NN', $BINRPC_ARRAY, $s).$r;
  1876. }
  1877. ######################################################################
  1878. # Encode struct (type = 257)
  1879. # Input is hash reference. Hash elements:
  1880. # hash->{$element}{T} = Type
  1881. # hash->{$element}{V} = Value
  1882. ######################################################################
  1883. sub HMCCURPCPROC_EncStruct ($)
  1884. {
  1885. my ($h) = @_;
  1886. my $r = '';
  1887. my $s = 0;
  1888. foreach my $k (keys %{$h}) {
  1889. $r .= HMCCURPCPROC_EncName ($k);
  1890. $r .= HMCCURPCPROC_EncType ($h->{$k}{T}, $h->{$k}{V});
  1891. $s++;
  1892. }
  1893. return pack ('NN', $BINRPC_STRUCT, $s).$r;
  1894. }
  1895. ######################################################################
  1896. # Encode any type
  1897. # Input is type and value
  1898. # Return encoded data or empty string on error
  1899. ######################################################################
  1900. sub HMCCURPCPROC_EncType ($$)
  1901. {
  1902. my ($t, $v) = @_;
  1903. if ($t == $BINRPC_INTEGER) {
  1904. return HMCCURPCPROC_EncInteger ($v);
  1905. }
  1906. elsif ($t == $BINRPC_BOOL) {
  1907. return HMCCURPCPROC_EncBool ($v);
  1908. }
  1909. elsif ($t == $BINRPC_STRING) {
  1910. return HMCCURPCPROC_EncString ($v);
  1911. }
  1912. elsif ($t == $BINRPC_DOUBLE) {
  1913. return HMCCURPCPROC_EncDouble ($v);
  1914. }
  1915. elsif ($t == $BINRPC_BASE64) {
  1916. return HMCCURPCPROC_EncBase64 ($v);
  1917. }
  1918. elsif ($t == $BINRPC_ARRAY) {
  1919. return HMCCURPCPROC_EncArray ($v);
  1920. }
  1921. elsif ($t == $BINRPC_STRUCT) {
  1922. return HMCCURPCPROC_EncStruct ($v);
  1923. }
  1924. else {
  1925. return '';
  1926. }
  1927. }
  1928. ######################################################################
  1929. # Encode RPC request with method and optional parameters.
  1930. # Headers are not supported.
  1931. # Input is method name and reference to parameter array.
  1932. # Array must contain (type, value) pairs
  1933. # Return encoded data or empty string on error
  1934. ######################################################################
  1935. sub HMCCURPCPROC_EncodeRequest ($$)
  1936. {
  1937. my ($method, $args) = @_;
  1938. # Encode method
  1939. my $m = HMCCURPCPROC_EncName ($method);
  1940. # Encode parameters
  1941. my $r = '';
  1942. my $s = 0;
  1943. if (defined ($args)) {
  1944. while (my $t = shift @$args) {
  1945. my $e = shift @$args;
  1946. last if (!defined ($e));
  1947. $r .= HMCCURPCPROC_EncType ($t, $e);
  1948. $s++;
  1949. }
  1950. }
  1951. # Method, ParameterCount, Parameters
  1952. $r = $m.pack ('N', $s).$r;
  1953. # Identifier, ContentLength, Content
  1954. # Ggf. +8
  1955. $r = pack ('NN', $BINRPC_REQUEST, length ($r)+8).$r;
  1956. return $r;
  1957. }
  1958. ######################################################################
  1959. # Encode RPC response
  1960. # Input is type and value
  1961. ######################################################################
  1962. sub HMCCURPCPROC_EncodeResponse ($$)
  1963. {
  1964. my ($t, $v) = @_;
  1965. if (defined ($t) && defined ($v)) {
  1966. my $r = HMCCURPCPROC_EncType ($t, $v);
  1967. # Ggf. +8
  1968. return pack ('NN', $BINRPC_RESPONSE, length ($r)+8).$r;
  1969. }
  1970. else {
  1971. return pack ('NN', $BINRPC_RESPONSE);
  1972. }
  1973. }
  1974. ######################################################################
  1975. # Binary RPC decoding functions
  1976. ######################################################################
  1977. ######################################################################
  1978. # Decode integer (type = 1)
  1979. # Return (value, packetsize) or (undef, undef)
  1980. ######################################################################
  1981. sub HMCCURPCPROC_DecInteger ($$$)
  1982. {
  1983. my ($d, $i, $u) = @_;
  1984. return ($i+4 <= length ($d)) ? (unpack ($u, substr ($d, $i, 4)), 4) : (undef, undef);
  1985. }
  1986. ######################################################################
  1987. # Decode bool (type = 2)
  1988. # Return (value, packetsize) or (undef, undef)
  1989. ######################################################################
  1990. sub HMCCURPCPROC_DecBool ($$)
  1991. {
  1992. my ($d, $i) = @_;
  1993. return ($i+1 <= length ($d)) ? (unpack ('C', substr ($d, $i, 1)), 1) : (undef, undef);
  1994. }
  1995. ######################################################################
  1996. # Decode string or void (type = 3)
  1997. # Return (string, packet size) or (undef, undef)
  1998. # Return ('', 4) for special type 'void'
  1999. ######################################################################
  2000. sub HMCCURPCPROC_DecString ($$)
  2001. {
  2002. my ($d, $i) = @_;
  2003. my ($s, $o) = HMCCURPCPROC_DecInteger ($d, $i, 'N');
  2004. if (defined ($s) && $i+$s+4 <= length ($d)) {
  2005. return $s > 0 ? (substr ($d, $i+4, $s), $s+4) : ('', 4);
  2006. }
  2007. return (undef, undef);
  2008. }
  2009. ######################################################################
  2010. # Decode double (type = 4)
  2011. # Return (value, packetsize) or (undef, undef)
  2012. ######################################################################
  2013. sub HMCCURPCPROC_DecDouble ($$)
  2014. {
  2015. my ($d, $i) = @_;
  2016. return (undef, undef) if ($i+8 > length ($d));
  2017. my $m = unpack ('l', reverse (substr ($d, $i, 4)));
  2018. my $e = unpack ('l', reverse (substr ($d, $i+4, 4)));
  2019. $m = $m/(1<<30);
  2020. my $v = $m*(2**$e);
  2021. return (sprintf ("%.6f",$v), 8);
  2022. }
  2023. ######################################################################
  2024. # Decode base64 encoded string (type = 17)
  2025. # Return (string, packetsize) or (undef, undef)
  2026. ######################################################################
  2027. sub HMCCURPCPROC_DecBase64 ($$)
  2028. {
  2029. my ($d, $i) = @_;
  2030. return HMCCURPCPROC_DecString ($d, $i);
  2031. }
  2032. ######################################################################
  2033. # Decode array (type = 256)
  2034. # Return (arrayref, packetsize) or (undef, undef)
  2035. ######################################################################
  2036. sub HMCCURPCPROC_DecArray ($$)
  2037. {
  2038. my ($d, $i) = @_;
  2039. my @r = ();
  2040. my ($s, $x) = HMCCURPCPROC_DecInteger ($d, $i, 'N');
  2041. if (defined ($s)) {
  2042. my $j = $x;
  2043. for (my $n=0; $n<$s; $n++) {
  2044. my ($v, $o) = HMCCURPCPROC_DecType ($d, $i+$j);
  2045. return (undef, undef) if (!defined ($o));
  2046. push (@r, $v);
  2047. $j += $o;
  2048. }
  2049. return (\@r, $j);
  2050. }
  2051. return (undef, undef);
  2052. }
  2053. ######################################################################
  2054. # Decode struct (type = 257)
  2055. # Return (hashref, packetsize) or (undef, undef)
  2056. ######################################################################
  2057. sub HMCCURPCPROC_DecStruct ($$)
  2058. {
  2059. my ($d, $i) = @_;
  2060. my %r;
  2061. my ($s, $x) = HMCCURPCPROC_DecInteger ($d, $i, 'N');
  2062. if (defined ($s)) {
  2063. my $j = $x;
  2064. for (my $n=0; $n<$s; $n++) {
  2065. my ($k, $o1) = HMCCURPCPROC_DecString ($d, $i+$j);
  2066. return (undef, undef) if (!defined ($o1));
  2067. my ($v, $o2) = HMCCURPCPROC_DecType ($d, $i+$j+$o1);
  2068. return (undef, undef) if (!defined ($o2));
  2069. $r{$k} = $v;
  2070. $j += $o1+$o2;
  2071. }
  2072. return (\%r, $j);
  2073. }
  2074. return (undef, undef);
  2075. }
  2076. ######################################################################
  2077. # Decode any type
  2078. # Return (element, packetsize) or (undef, undef)
  2079. ######################################################################
  2080. sub HMCCURPCPROC_DecType ($$)
  2081. {
  2082. my ($d, $i) = @_;
  2083. return (undef, undef) if ($i+4 > length ($d));
  2084. my @r = ();
  2085. my $t = unpack ('N', substr ($d, $i, 4));
  2086. $i += 4;
  2087. if ($t == $BINRPC_INTEGER) {
  2088. # Integer
  2089. @r = HMCCURPCPROC_DecInteger ($d, $i, 'N');
  2090. }
  2091. elsif ($t == $BINRPC_BOOL) {
  2092. # Bool
  2093. @r = HMCCURPCPROC_DecBool ($d, $i);
  2094. }
  2095. elsif ($t == $BINRPC_STRING || $t == $BINRPC_BASE64) {
  2096. # String / Base64
  2097. @r = HMCCURPCPROC_DecString ($d, $i);
  2098. }
  2099. elsif ($t == $BINRPC_DOUBLE) {
  2100. # Double
  2101. @r = HMCCURPCPROC_DecDouble ($d, $i);
  2102. }
  2103. elsif ($t == $BINRPC_ARRAY) {
  2104. # Array
  2105. @r = HMCCURPCPROC_DecArray ($d, $i);
  2106. }
  2107. elsif ($t == $BINRPC_STRUCT) {
  2108. # Struct
  2109. @r = HMCCURPCPROC_DecStruct ($d, $i);
  2110. }
  2111. $r[1] += 4;
  2112. return @r;
  2113. }
  2114. ######################################################################
  2115. # Decode request.
  2116. # Return method, arguments. Arguments are returned as array.
  2117. ######################################################################
  2118. sub HMCCURPCPROC_DecodeRequest ($)
  2119. {
  2120. my ($data) = @_;
  2121. my @r = ();
  2122. my $i = 8;
  2123. return (undef, undef) if (length ($data) < 8);
  2124. # Decode method
  2125. my ($method, $o) = HMCCURPCPROC_DecString ($data, $i);
  2126. return (undef, undef) if (!defined ($method));
  2127. $i += $o;
  2128. my $c = unpack ('N', substr ($data, $i, 4));
  2129. $i += 4;
  2130. for (my $n=0; $n<$c; $n++) {
  2131. my ($d, $s) = HMCCURPCPROC_DecType ($data, $i);
  2132. return (undef, undef) if (!defined ($d) || !defined ($s));
  2133. push (@r, $d);
  2134. $i += $s;
  2135. }
  2136. return (lc ($method), \@r);
  2137. }
  2138. ######################################################################
  2139. # Decode response.
  2140. # Return (ref, type) or (undef, undef)
  2141. # type: 1=ok, 0=error
  2142. ######################################################################
  2143. sub HMCCURPCPROC_DecodeResponse ($)
  2144. {
  2145. my ($data) = @_;
  2146. return (undef, undef) if (length ($data) < 8);
  2147. my $id = unpack ('N', substr ($data, 0, 4));
  2148. if ($id == $BINRPC_RESPONSE) {
  2149. # Data
  2150. my ($result, $offset) = HMCCURPCPROC_DecType ($data, 8);
  2151. return ($result, 1);
  2152. }
  2153. elsif ($id == $BINRPC_ERROR) {
  2154. # Error
  2155. my ($result, $offset) = HMCCURPCPROC_DecType ($data, 8);
  2156. return ($result, 0);
  2157. }
  2158. # Response with header not supported
  2159. # elsif ($id == 0x42696E41) {
  2160. # }
  2161. return (undef, undef);
  2162. }
  2163. 1;
  2164. =pod
  2165. =item device
  2166. =item summary provides RPC server for connection between FHEM and Homematic CCU2
  2167. =begin html
  2168. <a name="HMCCURPCPROC"></a>
  2169. <h3>HMCCURPCPROC</h3>
  2170. <ul>
  2171. The module provides a subprocess based RPC server for receiving events from HomeMatic CCU2.
  2172. A HMCCURPCPROC device acts as a client device for a HMCCU I/O device. Normally RPC servers of
  2173. type HMCCURPCPROC are started or stopped from HMCCU I/O device via command 'set rpcserver on,off'.
  2174. HMCCURPCPROC devices will be created automatically by I/O device when RPC server is started.
  2175. There should be no need for creating HMCCURPCPROC devices manually.
  2176. </br></br>
  2177. <a name="HMCCURPCPROCdefine"></a>
  2178. <b>Define</b><br/><br/>
  2179. <ul>
  2180. <code>define &lt;name&gt; HMCCURPCPROC {&lt;HostOrIP&gt;|iodev=&lt;DeviceName&gt;}
  2181. {&lt;port&gt;|&lt;interface&gt;}</code>
  2182. <br/><br/>
  2183. Examples:<br/>
  2184. <code>define myccurpc HMCCURPCPROC 192.168.1.10 2001</code><br/>
  2185. <code>define myccurpc HMCCURPCPROC iodev=myccudev BidCos-RF</code><br/>
  2186. <br/><br/>
  2187. The parameter <i>HostOrIP</i> is the hostname or IP address of a Homematic CCU2.
  2188. The I/O device can also be specified with parameter iodev. If more than one CCU exist
  2189. it's highly recommended to specify IO device with option iodev. Supported interfaces or
  2190. ports are:
  2191. <table>
  2192. <tr><td><b>Port</b></td><td><b>Interface</b></td></tr>
  2193. <tr><td>2000</td><td>BidCos-Wired</td></tr>
  2194. <tr><td>2001</td><td>BidCos-RF</td></tr>
  2195. <tr><td>2010</td><td>HmIP-RF</td></tr>
  2196. <tr><td>7000</td><td>HVL</td></tr>
  2197. <tr><td>8701</td><td>CUxD</td></tr>
  2198. <tr><td>9292</td><td>Virtual</td></tr>
  2199. </table>
  2200. </ul>
  2201. <br/>
  2202. <a name="HMCCURPCPROCset"></a>
  2203. <b>Set</b><br/><br/>
  2204. <ul>
  2205. <li><b>set &lt;name&gt; deregister</b><br/>
  2206. Deregister RPC server at CCU.
  2207. </li><br/>
  2208. <li><b>set &lt;name&gt; register</b><br/>
  2209. Register RPC server at CCU. RPC server must be running. Helpful when CCU lost
  2210. connection to FHEM and events timed out.
  2211. </li><br/>
  2212. <li><b>set &lt;name&gt; rpcrequest &lt;method&gt; [&lt;parameters&gt;]</b><br/>
  2213. Send RPC request to CCU. The result is displayed in FHEM browser window. See EQ-3
  2214. RPC XML documentation for mor information about valid methods and requests.
  2215. </li><br/>
  2216. <li><b>set &lt;name&gt; rpcserver { on | off }</b><br/>
  2217. Start or stop RPC server. This command is only available if expert mode is activated.
  2218. </li><br/>
  2219. </ul>
  2220. <a name="HMCCURPCPROCget"></a>
  2221. <b>Get</b><br/><br/>
  2222. <ul>
  2223. <li><b>get &lt;name&gt; rpcevent</b><br/>
  2224. Show RPC server events statistics.
  2225. </li><br/>
  2226. <li><b>get &lt;name&gt; rpcstate</b><br/>
  2227. Show RPC process state.
  2228. </li><br/>
  2229. </ul>
  2230. <a name="HMCCURPCPROCattr"></a>
  2231. <b>Attributes</b><br/><br/>
  2232. <ul>
  2233. <li><b>ccuflags { flag-list }</b><br/>
  2234. Set flags for controlling device behaviour. Meaning of flags is:<br/>
  2235. ccuInit - RPC server initialization depends on ListDevice RPC call issued by CCU.
  2236. This flag is not supported by interfaces CUxD and HVL.<br/>
  2237. expert - Activate expert mode<br/>
  2238. logEvents - Events are written into FHEM logfile if verbose is 4<br/>
  2239. noEvents - Ignore events from CCU, do not update client device readings.<br/>
  2240. queueEvents - Always write events into queue and send them asynchronously to FHEM.
  2241. Frequency of event transmission to FHEM depends on attribute rpcConnTimeout.<br/>
  2242. reconnect - Try to re-register at CCU if no events received for rpcEventTimeout seconds<br/>
  2243. </li><br/>
  2244. <li><b>rpcAcceptTimeout &lt;seconds&gt;</b><br/>
  2245. Specify timeout for accepting incoming connections. Default is 1 second. Increase this
  2246. value by 1 or 2 seconds on slow systems.
  2247. </li><br/>
  2248. <li><b>rpcConnTimeout &lt;seconds&gt;</b><br/>
  2249. Specify timeout of incoming CCU connections. Default is 1 second. Value must be greater than 0.
  2250. </li><br/>
  2251. <li><b>rpcEventTimeout &lt;seconds&gt;</b><br/>
  2252. Specify timeout for CCU events. Default is 600 seconds. If timeout occurs an event
  2253. is triggered. If set to 0 the timeout is ignored. If ccuflag reconnect is set the
  2254. RPC device tries to establish a new connection to the CCU.
  2255. </li><br/>
  2256. <li><b>rpcMaxEvents &lt;count&gt;</b><br/>
  2257. Specify maximum number of events read by FHEM during one I/O loop. If FHEM performance
  2258. slows down decrease this value and increase attribute rpcQueueSize. Default value is 100.
  2259. Value must be greater than 0.
  2260. </li><br/>
  2261. <li><b>rpcMaxIOErrors &lt;count&gt;</b><br/>
  2262. Specifiy maximum number of I/O errors allowed when sending events to FHEM before a
  2263. message is written into FHEM log file. Default value is 100. Set this attribute to 0
  2264. to disable error counting.
  2265. </li><br/>
  2266. <li><b>rpcQueueSend &lt;events&gt;</b><br/>
  2267. Maximum number of events sent to FHEM per accept loop. Default is 70. If set to 0
  2268. all events in queue are sent to FHEM. Transmission is stopped when an I/O error occurrs
  2269. or specified number of events has been sent.
  2270. </li><br/>
  2271. <li><b>rpcQueueSize &lt;count&gt;</b><br/>
  2272. Specify maximum size of event queue. When this limit is reached no more CCU events
  2273. are forwarded to FHEM. In this case increase this value or increase attribute
  2274. <b>rpcMaxEvents</b>. Default value is 500.
  2275. </li><br/>
  2276. <li><b>rpcServerAddr &lt;ip-address&gt;</b><br/>
  2277. Set local IP address of RPC servers on FHEM system. If attribute is missing the
  2278. corresponding attribute of I/O device (HMCCU device) is used or IP address is
  2279. detected automatically. This attribute should be set if FHEM is running on a system
  2280. with multiple network interfaces.
  2281. </li><br/>
  2282. <li><b>rpcServerPort &lt;port&gt;</b><br/>
  2283. Specify TCP port number used for calculation of real RPC server ports.
  2284. If attribute is missing the corresponding attribute of I/O device (HMCCU device)
  2285. is used. Default value is 5400.
  2286. </li><br/>
  2287. <li><b>rpcStatistics &lt;count&gt;</b><br/>
  2288. Specify amount of events after which statistic data is sent to FHEM. Default value
  2289. is 500.
  2290. </li><br/>
  2291. <li><b>rpcWriteTimeout &lt;seconds&gt;</b><br/>
  2292. Wait the specified time for socket to become readable or writeable. Default value
  2293. is 0.001 seconds.
  2294. </li>
  2295. </ul>
  2296. </ul>
  2297. =end html
  2298. =cut