Session Table Control

[Joe_Pruitt]

Problem this snippet solves:

This sample goes along with the Tech Tip titled Session Table Control With iRules . It creates an iRules-based HTML application to allow you to view, edit, delete, import, and export your session subtable data.

10/1/2020 - This iRule has been updated to fix the script tag, uri, and "C"ontent issues.

How to use this snippet:

Apply to a virtual server with session table entries and you can import/export/edit/delete entries.

Code :

when HTTP_REQUEST {
  set APPNAME "subtables";
  
  set luri  [string tolower [HTTP::path]]
  set app   [getfield $luri "/" 2];
  set cmd   [getfield $luri "/" 3];
  set tname [URI::decode [getfield [HTTP::path] "/" 4]];
  set arg1  [URI::decode [getfield [HTTP::path] "/" 5]];
  set arg2  [URI::decode [getfield [HTTP::path] "/" 6]];
  set resp "";
  
  set send_response 1;
  
  if { $app equals $APPNAME } {

    log local0. "Processing application $app...";

    if { $cmd eq "" } { set cmd "edit"; }
    if { $tname eq "file" } { set tname ""; }
    log local0. "INCOMING URI: $luri, app=$app, cmd=$cmd, tname=$tname";

    set TABLENAME_FORM "



Table Name





";
    
    set FILEINPUT_FORM "


  
File

  


";

    append resp "






iRule Table Control($cmd)
edit |
export |
import |
delete
"
      
    
    #------------------------------------------------------------------------
    # Process commands
    #------------------------------------------------------------------------
    switch $cmd {
      
      "edit" {
      #----------------------------------------------------------------------
      # edit
      #----------------------------------------------------------------------
        log local0. "SUBCOMMAND: edit";
        if { $tname eq "" } {
          append resp $TABLENAME_FORM
        } else {
          append resp "";
          append resp "\n";
          
          append resp "
\n";
          append resp "\n";
          append resp "\n";
          foreach key [table keys -subtable $tname] {
            append resp "";
            append resp "";
            append resp "";
            append resp "\n";
          }
          # Add insertion fields
          append resp "";
          append resp "";
          append resp "";
          append resp "
'$tname' Table
Key
Value
$key
[table lookup -subtable $tname $key]
\[X\]
\[+\]
\n";
          
          append resp "";
        }
      }
      
      "export" {
      #----------------------------------------------------------------------
      # export
      #----------------------------------------------------------------------
        log local0. "SUBCOMMAND: export";
        if { $tname eq "" } {
          append resp $TABLENAME_FORM
        } else {
          set csv "Table,Key,Value\n";
          foreach key [table keys -subtable $tname] {
            append csv "${tname},${key},[table lookup -subtable $tname $key]\n";
          }
          set filename [clock format [clock seconds] -format "%Y%m%d_%H%M%S_${tname}.csv"]
          log local0. "Responding with filename $filename...";
          
          set disp "attachment; filename=${filename}";
          HTTP::respond 200 content $csv "Content-Type" "text/csv" "Content-Disposition" $disp;
          return;
        }
      }
      
      "import" {
      #----------------------------------------------------------------------
      # import
      #----------------------------------------------------------------------
        if { [HTTP::method] eq "GET" } {
          append resp $FILEINPUT_FORM;
        } else {
          append resp "SUBMITTED FILE...";
          if { [HTTP::header exists "Content-Length"] } {
            log local0. "Collecting [HTTP::header Content-Length] bytes...";
            HTTP::collect [HTTP::header "Content-Length"];
            set send_response 0;
          } else {
            log local0. "Content-Length header doesn't exist!";
          }
        }
      }
      
      "delete" {
      #----------------------------------------------------------------------
      # delete
      #----------------------------------------------------------------------
        log local0. "SUBCOMMAND: delete";
        if { $tname eq "" } {
          append resp $TABLENAME_FORM
        } else {
          table delete -subtable $tname -all;
          append resp "
Subtable $tname successfully deleted
";
        }
      }
      
      "deletekey" {
      #----------------------------------------------------------------------
      # deletekey
      #----------------------------------------------------------------------
        log local0. "SUBCOMMAND: deletekey";
        if { ($tname ne "") && ($arg1 ne "") } {
          log local0. "Deleting subtable $tname key $arg1...";
          table delete -subtable $tname $arg1;
          HTTP::redirect "http://[HTTP::host]/${APPNAME}/edit/${tname}";
          return;
        }
      }
      
      "insertkey" {
      #----------------------------------------------------------------------
      # insertkey
      #----------------------------------------------------------------------
        log local0. "SUBCOMMAND: insert";
        if { ($tname ne "") && ($arg1 ne "") && ($arg2 ne "") } {
          log local0. "Inserting subtable $tname key $arg1...";
          table set -subtable $tname $arg1 $arg2 indefinite indefinite
          HTTP::redirect "http://[HTTP::host]/${APPNAME}/edit/${tname}";
          return;
        }
      }
      
    }
    
    if { $send_response == 1 } {
      append resp "
";
      HTTP::respond 200 content $resp;
    }
  }
}

when HTTP_REQUEST_DATA {
  
  log local0. "HTTP_REQUEST_DATA -> app $app";
  if { $app eq $APPNAME } {
    switch $cmd {
      "import" {
        set payload [HTTP::payload]

        #------------------------------------------------------------------------
        # Extract Boundary from "Content-Type" header
        #------------------------------------------------------------------------
        set ctype [HTTP::header "Content-Type"];
        set tokens [split $ctype ";"];
        set boundary "";
        foreach {token} $tokens {
          set t2 [split [string trim $token] "="];
          set name [lindex $t2 0];
          set val [lindex $t2 1];
          if { $name eq "boundary" } {
            set boundary $val;
          }
        }
        
        #------------------------------------------------------------------------
        # Process POST data
        #------------------------------------------------------------------------
        set in_boundary 0;
        set in_filedata 0;
        set past_headers 0;
        set process_data 0;
        set num_lines 0;
        if { "" ne $boundary } {
          
          log local0. "Boundary '$boundary'";
          set lines [split [HTTP::payload] "\n"]
          foreach {line} $lines {
            
            set line [string trim $line];
            log local0. "LINE: '$line'";
            
            if { $line contains $boundary } {

              if { $in_boundary == 0 } {
                #----------------------------------------------------------------
                # entering boundary
                #----------------------------------------------------------------
                log local0. "Entering boundary";
                set in_boundary 1;
                set in_filedata 0;
                set past_headers 0;
                set process_data 0;
              } else {
                #----------------------------------------------------------------
                # exiting boundary
                #----------------------------------------------------------------
                log local0. "Exiting boundary";
                set in_boundary 0;
                set in_filedata 0;
                set past_headers 0;
                set process_data 0;
              }
            } else {
              
              #------------------------------------------------------------------
              # in boundary so check for file content
              #------------------------------------------------------------------
              if { ($line starts_with "Content-Disposition: ") &&
                   ($line contains "filedata") } {
                log local0. "In Filedata";
                set in_filedata 1;
                continue;
              } elseif { $line eq "" } {
                log local0. "Exiting headers";
                set past_headers 1;
              }
            }
            
            if { $in_filedata && $process_data } {
              log local0. "Appending line";
              
              if { ($num_lines > 0) && ($line ne "") } {
                #----------------------------------------------------------------
                # Need to parse line and insert into table
                # line is format : Name,Key,Value
                #----------------------------------------------------------------
                set t [getfield $line "," 1];
                set k [getfield $line "," 2];
                set v [getfield $line "," 3] 
                
                if { ($t ne "") && ($k ne "") && ($v ne "") } {
                  log local0. "Adding table '$t' entry '$k' => '$v'";
                  table set -subtable $t $k $v indefinite indefinite
                }
              }
              incr num_lines;
            }
            
            if { $past_headers } {
              log local0. "Begin processing data";
              set process_data 1;
            }
          }
        }
        incr num_lines -2;
        append resp "
Successfully imported $num_lines table records
";
        append resp "";
        HTTP::respond 200 content $resp;
      }
    }
  }
}

[craig_011_16230]

the "C" in content must be lower case for this to function, but works great otherwise. Thanks!

[kcobean_191923]

I'm trying to use this but I get a blank page in my browser. (if I telnet to the vServer and request /subtables/edit, I get the proper content back, I think). I assume the comment at the top of the article about correcting the script tag means that the --> and //--> need to be removed so that only the tags remain. Am I getting that wrong?

[Ryan77777]

Anywhere you have this:

Replace with this:

[SaranSakthivel]

👍

[Tom_Schaefer]

I found this recently and greatly appreciate the code. It has made monitoring a table very easy. I do have one caution to anyone else using it. The act of refreshing the edit display to see what is in the table, resets the timeout. In my case,. I did not want the observation of the table to reset the time. I added -notouch to the line

foreach key [table keys -notouch -subtable $tname] {

(line 133 above). I also added -notouch to line 135 so it reads

append resp "<td class='tvalue'>[table lookup -notouch -subtable $tname $key]</td>";