From 5aa8bef920a2034be264a1bb289f1c19392e8ee1 Mon Sep 17 00:00:00 2001
From: dakkar <dakkar@thenautilus.net>
Date: Fri, 14 Sep 2012 15:28:49 +0100
Subject: first working version

---
 .gitignore            |   3 +
 lib/Linux/FANotify.pm | 150 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 153 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 lib/Linux/FANotify.pm

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..90e6650
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,3 @@
+/_Inline/
+*~
+.#*
diff --git a/lib/Linux/FANotify.pm b/lib/Linux/FANotify.pm
new file mode 100644
index 0000000..cf30ba0
--- /dev/null
+++ b/lib/Linux/FANotify.pm
@@ -0,0 +1,150 @@
+package Linux::FANotify;
+use 5.016;
+use strict;
+use warnings;
+my $ccode;
+BEGIN {
+my @constants=qw(
+                    FAN_ACCESS
+                    FAN_MODIFY
+                    FAN_CLOSE_WRITE
+                    FAN_CLOSE_NOWRITE
+                    FAN_OPEN
+                    FAN_Q_OVERFLOW
+                    FAN_OPEN_PERM
+                    FAN_ACCESS_PERM
+                    FAN_ONDIR
+                    FAN_EVENT_ON_CHILD
+                    FAN_CLOSE
+                    FAN_CLOEXEC
+                    FAN_NONBLOCK
+                    FAN_CLASS_NOTIF
+                    FAN_CLASS_CONTENT
+                    FAN_CLASS_PRE_CONTENT
+                    FAN_ALL_CLASS_BITS
+                    FAN_UNLIMITED_QUEUE
+                    FAN_UNLIMITED_MARKS
+                    FAN_ALL_INIT_FLAGS
+                    FAN_MARK_ADD
+                    FAN_MARK_REMOVE
+                    FAN_MARK_DONT_FOLLOW
+                    FAN_MARK_ONLYDIR
+                    FAN_MARK_MOUNT
+                    FAN_MARK_IGNORED_MASK
+                    FAN_MARK_IGNORED_SURV_MODIFY
+                    FAN_MARK_FLUSH
+                    FAN_ALL_MARK_FLAGS
+                    FAN_ALL_EVENTS
+                    FAN_ALL_PERM_EVENTS
+                    FAN_ALL_OUTGOING_EVENTS
+                    FANOTIFY_METADATA_VERSION
+                    FAN_ALLOW
+                    FAN_DENY
+                    FAN_NOFD
+            );
+$ccode=<<EOC;
+#include <sys/fanotify.h>
+#include <stdlib.h>
+#include <string.h>
+EOC
+for my $c (@constants) {
+    my $sub_name = lc($c =~ s{^.*?_}{}r);
+    $ccode .= "long CONST_${sub_name}() { return $c; }\n";
+}
+$ccode.=<<EOC;
+int perl_fanotify_init(unsigned int flags, unsigned int event_f_flags) {
+    return fanotify_init(flags,event_f_flags);
+}
+
+int perl_fanotify_mark(int fanotify_fd, unsigned int flags,
+                       unsigned long mask, int dfd, const char *pathname) {
+    return fanotify_mark(fanotify_fd, flags, mask, dfd, pathname);
+}
+
+SV* perl_memalign(size_t alignment, size_t size) {
+  void* buffer=NULL;
+  int err;
+  err = posix_memalign(&buffer, alignment, size);
+  if (err != 0 || buffer == NULL) {
+    SV* bang = get_sv("!", 0);
+    sv_setiv(bang, (IV)err);
+    sv_setpvf(bang, "%s", strerror(err)); /* let Perl copy the string */
+    SvIOK_on(bang);
+    return &PL_sv_undef;
+  }
+  return sv_2mortal(newSVpvn(buffer,size));
+}
+AV* unpack_events(SV* svbuffer) {
+    STRLEN len;
+    void * buffer = SvPV(svbuffer,len);
+    AV* ret = newAV();
+    HV* event;
+    struct fanotify_event_metadata *data;
+    data = (struct fanotify_event_metadata *) buffer;
+
+    while(FAN_EVENT_OK(data,len)) {
+        event = newHV();
+        av_push(ret,newRV_noinc((SV*)event));
+        hv_store(event,"mask",4,newSViv(data->mask),0);
+        hv_store(event,"fd",2,newSViv(data->fd),0);
+        hv_store(event,"pid",3,newSViv(data->pid),0);
+        buffer = FAN_EVENT_NEXT(data,len);
+    }
+
+    return ret;
+}
+EOC
+}
+use Inline C => $ccode;
+use POSIX qw();
+use Data::Printer;
+
+my $fan_fd = perl_fanotify_init(0,0);
+
+warn "fan fd: $fan_fd $!";
+my $fan_fh;open($fan_fh,'<&=',$fan_fd);
+
+my $ret = perl_fanotify_mark($fan_fd,
+                        CONST_mark_add | CONST_mark_mount,
+                        CONST_open | CONST_close, 0, '/tmp');
+if ($ret < 0) {
+    die "WTF? $ret";
+}
+
+my $buffer;#=perl_memalign(4096,8192);
+
+sub program_for_pid {
+    my ($pid) = @_;
+
+    my $ret = "<unknown program ($pid)>";
+
+    open my $fh,'<',"/proc/$pid/cmdline" or return $ret;
+
+    my $cmdline = do { local $/;<$fh> };chomp $cmdline;
+
+    return $cmdline || $ret;
+}
+
+sub print_event {
+    my ($ev) = @_;
+
+    my $procname = program_for_pid($ev->{pid});
+    my $filename = readlink "/proc/self/fd/".$ev->{fd};
+    $filename ||= "<unknown file ($ev->{fd})>";
+    my $mask = $ev->{mask};
+
+    print "$procname ($mask) $filename\n";
+    POSIX::close($ev->{fd});
+}
+
+while (1) {
+    my $len = sysread($fan_fh,$buffer,8192,0);
+    my $ret = unpack_events($buffer);
+
+    for my $ev (@$ret) {
+        print_event($ev);
+    }
+}
+
+close $fan_fh;
+
-- 
cgit v1.2.3