From 835dcf2c282cb8fa90365ef34569c9a86ddfa7db Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fernando=20Corr=C3=AAa=20de=20Oliveira?= Date: Wed, 28 Aug 2024 02:15:49 +0100 Subject: [PATCH] feat(rewrite): rewrite it. Make it interal to the language --- examples/fire-risk | 14 -- examples/fire-risk.rakumod | 28 ++++ .../{port-knocking => port-knocking.rakumod} | 0 fire-risk-all.rakumod | 43 ++++++ lib/EEL.rakumod | 56 ++++---- lib/Event.rakumod | 41 ++++++ lib/MetamodelX/Event.rakumod | 52 +++++++ lib/QueryStorage.rakumod | 5 +- lib/QueryStorage/Branch.rakumod | 13 +- mindstorm/FireRisk.rakumod | 26 ++-- mindstorm/Login.rakumod | 38 ++---- mindstorm/PortKnocking.rakumod | 20 +++ port-knocking-all.rakumod | 88 ++++++++++++ port-knocking-all2.rakumod | 128 ++++++++++++++++++ port-knocking-all3.rakumod | 94 +++++++++++++ 15 files changed, 559 insertions(+), 87 deletions(-) delete mode 100644 examples/fire-risk create mode 100644 examples/fire-risk.rakumod rename examples/{port-knocking => port-knocking.rakumod} (100%) create mode 100644 fire-risk-all.rakumod create mode 100644 lib/Event.rakumod create mode 100644 lib/MetamodelX/Event.rakumod create mode 100644 mindstorm/PortKnocking.rakumod create mode 100644 port-knocking-all.rakumod create mode 100644 port-knocking-all2.rakumod create mode 100644 port-knocking-all3.rakumod diff --git a/examples/fire-risk b/examples/fire-risk deleted file mode 100644 index 497e1ec..0000000 --- a/examples/fire-risk +++ /dev/null @@ -1,14 +0,0 @@ -event temperature { has $value, $area } -event humidity { has $value, $area } -event fire-risk { - has $temperature = #temp.value; - has $humidity = #hum.value; - has $area = #temp.area; - match { - [ - temperature(#temp, value > 40, ?area == #hum.area) - & - humidity(#hum, value < 20, ?area == #temp.area) - ] 5min - } -} \ No newline at end of file diff --git a/examples/fire-risk.rakumod b/examples/fire-risk.rakumod new file mode 100644 index 0000000..54f5fa7 --- /dev/null +++ b/examples/fire-risk.rakumod @@ -0,0 +1,28 @@ +use lib "lib"; +use EEL; + +event fire-risk { + has Rat $.temperature = $; + has Rat $.humidity = $; + has Str $.area = $ // $; + + pattern TOP { + [ + | + | + ] 5min + <{ $ eq $ }> + } + + pattern temp { + )> + <{ $ > 40 }> + { $!area = $ } + } + + pattern hum { + )> + <{ $ < 20 }> + { $!area = $ } + } +} diff --git a/examples/port-knocking b/examples/port-knocking.rakumod similarity index 100% rename from examples/port-knocking rename to examples/port-knocking.rakumod diff --git a/fire-risk-all.rakumod b/fire-risk-all.rakumod new file mode 100644 index 0000000..ba5a00e --- /dev/null +++ b/fire-risk-all.rakumod @@ -0,0 +1,43 @@ +use lib "lib"; + +role Event is Capture { + has Pair @.pos; + method match(Supply $supply, Str :$rule = "TOP") { + supply { + whenever $supply -> $ev { + self!step($ev, :$rule) + } + } + } + + method !step($ev, Str :$rule) { + my @*pos = @!pos; + } +} + +class fire-risk does Event { + has Rat $.temperature = $; + has Rat $.humidity = $; + has Str $.area = $ // $; + + pattern TOP { + [ + | + | + ] 5min + <{ $ eq $ }> + } + + pattern temp { + )> + <{ $ > 40 }> + { $!area = $ } + } + + pattern hum { + )> + <{ $ < 20 }> + { $!area = $ } + } +} + diff --git a/lib/EEL.rakumod b/lib/EEL.rakumod index 5b71c55..c6033c3 100644 --- a/lib/EEL.rakumod +++ b/lib/EEL.rakumod @@ -1,27 +1,35 @@ -use EELParser; -use EventTranslator; -use Event::Runner; -use Event::AST; -unit class EEL; +# use EELParser; +# use EventTranslator; +# use Event::Runner; +# use Event::AST; +# unit class EEL; +# +# has Supply $.input; +# has EELParser $.parser .= new; +# has EventTranslator $.trans; +# has Str $.file; +# has Str $.code; +# has Event::AST:D @.ast = $!file.defined +# ?? $!parser.parse-file: $!file +# !! $!parser.parse: $!code +# ; +# has @.rules = EventTranslator.new.translate: @!ast; +# has Event::Runner $.runner .= new: :$!input, :@!rules; +# has Supply:D $.output handles * = $!runner.run; +# +# proto eel ($, :$code, :$file) is export {*} +# multi eel(@inputs, |c) { nextwith Supply.merge(@inputs), |c } +# multi eel(Supply:D $input, :$code! --> EEL) { +# EEL.new: :$input, :$code +# } +# multi eel(Supply:D $input, :$file! --> EEL) { +# EEL.new: :$input, :$file +# } -has Supply $.input; -has EELParser $.parser .= new; -has EventTranslator $.trans; -has Str $.file; -has Str $.code; -has Event::AST:D @.ast = $!file.defined - ?? $!parser.parse-file: $!file - !! $!parser.parse: $!code -; -has @.rules = EventTranslator.new.translate: @!ast; -has Event::Runner $.runner .= new: :$!input, :@!rules; -has Supply:D $.output handles * = $!runner.run; +use MetamodelX::Event; -proto eel ($, :$code, :$file) is export {*} -multi eel(@inputs, |c) { nextwith Supply.merge(@inputs), |c } -multi eel(Supply:D $input, :$code! --> EEL) { - EEL.new: :$input, :$code +my package EXPORTHOW { + package DECLARE { + constant event = MetamodelX::Event; + } } -multi eel(Supply:D $input, :$file! --> EEL) { - EEL.new: :$input, :$file -} \ No newline at end of file diff --git a/lib/Event.rakumod b/lib/Event.rakumod new file mode 100644 index 0000000..c1d47df --- /dev/null +++ b/lib/Event.rakumod @@ -0,0 +1,41 @@ +use QueryStorage; +unit class Event is Any; + +has Event $.parent; +has UInt $.pos = 0; +has Str $.rule; +has $.event; +has QueryStorage $.storage .= new; +has $.actions; +has $.made; + +method parse(Supply $supply, Str :$rule = "TOP") { + my $parent = self.^run: $rule; + supply { + whenever $supply -> $event { + say $parent; + $parent.^step: $event + } + } +} + +method event(*%pars) { + my multi run(0) { + my %query is Map = %pars.kv.map: -> $key, $value { + do if $value !~~ Associative { + $key => %("==" => $value) + } else { + $key => $value + } + } + note "\$!storage.add: %query<>, {self.gist}"; + $!storage.add: %query, self + } + my multi run($) { + note "run: {self.gist}"; + $.^return + } + + run $.pos; + self +} diff --git a/lib/MetamodelX/Event.rakumod b/lib/MetamodelX/Event.rakumod new file mode 100644 index 0000000..3a779aa --- /dev/null +++ b/lib/MetamodelX/Event.rakumod @@ -0,0 +1,52 @@ +use Event; +unit class MetamodelX::Event is Metamodel::ClassHOW; + +method new_type(|c) { + my $type = callsame; + $type.^add_parent: Event; + $type +} + +method to-map(\match --> Map()) { + match.^attributes.map(-> $a { + $a.name.substr(2) => .<> with $a.get_value(match) + }) +} + +method clone(\match, *%p) { + match.new: |match.^to-map, |%p +} + +method step(\match, $event) { + my @nexts = match.storage.search: $event; + for @nexts -> $match { + $match.^run-next: $event + } +} + +method return(\match) { + my $rule = match.rule; + ."$rule"(match) with match.actions; + note "emit: {match.gist}"; + return emit match unless match.parent; + # Should it emit match.made if it exist? + match.parent.run-next: :parent(match) +} + +multi method store-submatch(\match, Str $rule) { + match.run-next(:hash(%(|match.hash, $rule => match.parent))) +} + +multi method store-submatch(\match) { + match.run-next(:list((|match.list, match.parent))) +} + +method run(\match, Str $rule, UInt $pos = 0, |c) { + match.new(:$rule, :$pos, :parent(match))."$rule"(|c) +} + +method run-next(\match, $event?, *%pars, |c) { + note "run-next: {match.gist}, $event"; + my $rule = match.rule; + match.clone(|(:$event with $event), :pos(match.pos + 1), |%pars)."$rule"(|c) # TODO: validate if pos exist +} diff --git a/lib/QueryStorage.rakumod b/lib/QueryStorage.rakumod index 30ab0bd..0bd8508 100644 --- a/lib/QueryStorage.rakumod +++ b/lib/QueryStorage.rakumod @@ -10,7 +10,8 @@ multi method add(%tests, \value) { # TODO: Fix, do not override. for %tests.pairs.sort.kv -> UInt $i, (:$key, :value($test)) { $value = $i + 1 == %tests ?? value !! ::?CLASS.new; - %branches{$key} .= add: $test, $value; + note "($key).add: $test.gist(), $value"; + %branches{$key} .= add: $test<>, $value; %branches := $value.branches if $value ~~ ::?CLASS } self @@ -27,4 +28,4 @@ method search(%obj) { } } } -} \ No newline at end of file +} diff --git a/lib/QueryStorage/Branch.rakumod b/lib/QueryStorage/Branch.rakumod index 6ebbb48..e62a3a1 100644 --- a/lib/QueryStorage/Branch.rakumod +++ b/lib/QueryStorage/Branch.rakumod @@ -9,17 +9,20 @@ has %!map = |@!types.map: { .op => $_ } method map($op) { %!map{$op}.new } -multi method add(::?CLASS:U: |c) { +proto method add(|c) {note c; {*}} +multi method add(::?CLASS:U: Pair $test, $value) { + note 1; my ::?CLASS $obj .= new; - $obj.add: |c; + $obj.add: $test, $value; $obj } -multi method add(::?CLASS:D: (:$key, :$value), \value) { - (%!lists{$key} //= self.map: $key) .= add: $value, value; +multi method add(::?CLASS:D: (:$key, :$value), $value2) { + note 2; + (%!lists{$key} //= self.map: $key) .= add: $value, $value2; self } method search(|c) { gather for %!lists.values { .take for .search: |c } -} \ No newline at end of file +} diff --git a/mindstorm/FireRisk.rakumod b/mindstorm/FireRisk.rakumod index 23e9285..29f35bb 100644 --- a/mindstorm/FireRisk.rakumod +++ b/mindstorm/FireRisk.rakumod @@ -1,30 +1,22 @@ ######################## # Emits a FireRisk event if its too hot and too dry on a given area ######################## - -event Temperature is generic-hash-event { has Int $.area; has Rat $.value } -event Humidity is generic-hash-event { has Int $.area; has Rat $.value } +use lib 'lib'; +use EEL; event FireRisk { - has Int $.area; - has Rat $.temparature; - has Rat $.humidity; - pattern TOP { [ - [ & ] - .area == $.area }> - { $!area = $.area } - ] in 5min - { $!temperature = $.value } - { $!humidity = $.value } + | )> + | )> + ] 5min } - pattern hot { - .value > 40 }> + pattern hot($area) { + , :value{'>' => 40 })> } - pattern dry { - .value < 20 }> + pattern dry($area) { + , :value{'<' => 20 })> } } diff --git a/mindstorm/Login.rakumod b/mindstorm/Login.rakumod index 5db203a..1e6607d 100644 --- a/mindstorm/Login.rakumod +++ b/mindstorm/Login.rakumod @@ -2,15 +2,6 @@ # Emits a Login event after getting the login page, 0, 1 or more login tries and a succefull login ######################## -event Request is generic-log-entry(&line-to-hash) { - has Str $.method; - has UInt $.status; - has Str $.path; - has %.data; - has DateTime $.timestamp; - has Str() %.headers -} - event Login { has UUID() $.session-id; has UInt $.tries; @@ -22,34 +13,31 @@ event Login { :my $form-id = $.data; * - { $!session-id = $.headers } - { $!tries = $.elems + 1 } - { $!start = $.timestamp } - { $!end = $.timestamp } + + { $!session-id = $ } + { $!tries = $.elems + 1 } + { $!start = $ } + { $!end = $ } } - pattern login-page { - .path eq "/login" }> + pattern login-page(*%pars) { + , |%pars)> } pattern login-form { - - .method eq "GET" && $.status == 200 }> + , :200status)> } - pattern login-action(UUID() $form-id) { - - .method eq "POST" && $.data eq $form-id }> + pattern login-action(UUID() $form-id, *%pars) { + , "data.form-id" => $form-id, |%pars)> } - pattern login-action-fail(UUID() $form-id) { - - .status div 100 != 2 }> + pattern login-action-fail(UUID() $form-id) { + 200, '>=' => 300])> } pattern login-action-success(UUID() $form-id) { - - .status div 100 == 2 }> + =' => 200, '<' => 300})> } } diff --git a/mindstorm/PortKnocking.rakumod b/mindstorm/PortKnocking.rakumod new file mode 100644 index 0000000..aa411fe --- /dev/null +++ b/mindstorm/PortKnocking.rakumod @@ -0,0 +1,20 @@ +######################## +# Emits when finds the secret knocking +######################## +use lib 'lib'; +use EEL; +event knocked-the-secret { + has $.ip; + + pattern TOP { + , :1port)> { $!ip = $ } + <.event(:type, :2port, :$!ip)> + <.event(:type, :3port, :$!ip)> + [ + <.event(:type, :1port, :$!ip)> + <.event(:type, :2port, :$!ip)> + <.event(:type, :3port, :$!ip)> + ] ** 2 + } +} + diff --git a/port-knocking-all.rakumod b/port-knocking-all.rakumod new file mode 100644 index 0000000..d6adcca --- /dev/null +++ b/port-knocking-all.rakumod @@ -0,0 +1,88 @@ +use lib 'lib'; +use EEL; +event knocked-the-secret { + + has $.id; + + pattern TOP { + [ + )> <{ $ == 1 }> { $!id //= $ } + )> <{ $ == 2 && $ eq $!id }> + )> <{ $ == 3 && $ eq $!id }> + ] ** 2 + } +} + +my $storge; + +role Event { + method match(Supply $supply, Str :$rule = "TOP") { + supply { + whenever $supply -> $ev { + self!step($ev) + } + } + } + + method !step($ev) { + my @nexts = $storge.query: $ev; + } + + method event(*%pars) { + my $ev = $*EV; + my $current = self; + + my %query is Map = %pars.kv.map: -> $key, $value { + $key => "==" => $value + } + $storge.add-query: :%query, :$current + } +} + +class knocked-the-secret does Event { + has $.id; + + method TOP { + my $ev = $*EV; + my $current = self; + + my @code = [ + -> $/ { $ == 1 }, + -> $/ { $!id //= $ }, + -> $/ { $ == 2 && $ eq $!id }, + -> $/ { $ == 3 && $ eq $!id }, + ]; + + sub again(UInt $count = 1, $while = 1) { + return unless $count > 0 || $while; + my %event is Map = :type; + my &*NEXT = -> $ev { + $current = $ev; + return unless @code[0].($current) + @code[1].($current); + + my %event is Map = :type; + my &*NEXT = -> $ev { + $current = $ev; + return unless @code[2].($current); + + my %event is Map = :type; + my &*NEXT = -> $ev { + $current = $ev; + return unless @code[3].($current); + + again $count - 1, $while - 1; + if !$count && $while { + emit $current + } + } + $.event: |%event; + } + $.event: |%event; + } + $.event: |%event; + } + + again 2 + } +} diff --git a/port-knocking-all2.rakumod b/port-knocking-all2.rakumod new file mode 100644 index 0000000..120a08f --- /dev/null +++ b/port-knocking-all2.rakumod @@ -0,0 +1,128 @@ +use lib 'lib'; +use EEL; +event knocked-the-secret { + + has $.id; + + pattern TOP { + [ + )> <{ $ == 1 }> { $!id //= $ } + )> <{ $ == 2 && $ eq $!id }> + )> <{ $ == 3 && $ eq $!id }> + ] ** 2 + } +} + +my $storge; + +role Event { + has Event $.parent; + has UInt $.pos = 0; + has Str $.rule; + has $.event; + + method min {...} + method max {...} + + method match(Supply $supply, Str :$rule = "TOP") { + my $parent = self.run: $rule; + supply { + whenever $supply -> $ev { + my $*EV = $ev; + $parent.step($ev) + } + } + } + method to-map(--> Map()) { + self.^attributes.map(-> $a { + $a.name.substr(2) => .<> with $a.get_value(self) + }) + } + + method clone(*%p) { + $.new: |$.to-map, |%p + } + + method step($ev) { + my @nexts = $storge.query: $ev; + } + + method return { + $.clone(:event($*EV)).parent.run-next: :parent(self) + } + + method event(*%pars) { + given $.pos { + when 0 { + my %query is Map = %pars.kv.map: -> $key, $value { + $key => "==" => $value + } + $storge.add-query: :%query, :match(self.clone: :$!parent, :pos($.pos + 1)) + } + when 1 { + $.return + } + } + } + + method run(Str $rule, UInt $pos = 0, |c) { + self.new(:$rule, :$pos, :parent(self))."$rule"(|c) + } + + method run-next(*%pars, |c) { + self.clone(:pos($.pos + 1), |%pars)."$.rule()"(|c) + } +} + +class knocked-the-secret does Event { + has $.id; + has Num $.min = 2; + has Num $.max = 2; + + method TOP { + given $.pos { + when 0 { + self.run: 'event', :type; + } + when 1 { + $.clone(:hash{|$.hash, :first($.parent)}); + } + when 2 { + my $/ = self; + my &code = { $ == 1 }; + return unless code; + $.run-next + } + when 3 { + my $/ = self; + my &code = { $!id //= $ }; + code; + $.run-next + } + when 4 { + self.run: 'event', :type; + } + when 5 { + $.clone(:hash{|$.hash, :second($.parent)}); + } + when 6 { + my $/ = self; + my &code = { $ == 2 }; + return unless code; + $.run-next + } + when 7 { + self.run: 'event', :type; + } + when 8 { + $.clone(:hash{|$.hash, :third($.parent)}); + } + when 9 { + my $/ = self; + my &code = { $ == 2 }; + return unless code; + $.run-next + } + } + } +} diff --git a/port-knocking-all3.rakumod b/port-knocking-all3.rakumod new file mode 100644 index 0000000..2bc2396 --- /dev/null +++ b/port-knocking-all3.rakumod @@ -0,0 +1,94 @@ +use lib 'lib'; +use EEL; +event knocked-the-secret { + has $.ip; + + pattern TOP { + , :1port)> { $!ip = $ } + <.event(:type, :2port, :$!ip)> + <.event(:type, :3port, :$!ip)> + [ + <.event(:type, :1port, :$!ip)> + <.event(:type, :2port, :$!ip)> + <.event(:type, :3port, :$!ip)> + ] ** 2 + } +} + +my $storge; + +role Event { + has Event $.parent; + has UInt $.pos = 0; + has Str $.rule; + has $.event; + + method min {...} + method max {...} + + method match(Supply $supply, Str :$rule = "TOP") { + my $parent = self.run: $rule; + supply { + whenever $supply -> $event { + $parent.step: $event + } + } + } + method to-map(--> Map()) { + self.^attributes.map(-> $a { + $a.name.substr(2) => .<> with $a.get_value(self) + }) + } + + method clone(*%p) { + $.new: |$.to-map, |%p + } + + method step($event) { + my @nexts = $storge.query: $event; + for @nexts -> $match { + $match.run-next: $event + } + } + + method return { + return emit self unless $!parent; # Should it emit $!made if it exist? + # TODO: Call action? Rule name on $!rule. `$action."$!rule"(self)`? + $!parent.run-next: :parent(self) + } + + multi method store-submatch(Str $rule) { + $.run-next(:hash(%(|$.hash, $rule => $!parent))) + } + + multi method store-submatch { + $.run-next(:list((|$.list, $!parent))) + } + + method event(*%pars) { + my multi run(0) { + my %query is Map = %pars.kv.map: -> $key, $value { + do if $value !~~ Associative { + $key => %("==" => $value) + } else { + $key => $value + } + } + $storge.add-query: :%query, :match(self) + } + my multi run($) { + $.return + } + + run $.pos + } + + method run(Str $rule, UInt $pos = 0, |c) { + self.new(:$rule, :$pos, :parent(self))."$rule"(|c) + } + + method run-next($event?, *%pars, |c) { + self.clone(|(:$event with $event), :pos($.pos + 1), |%pars)."$.rule()"(|c) # TODO: validate if pos exist + } +} +